ACSI Backtesting Analysis

What is the relationship between the American Consumer Satisfaction Index (ACSI) scores and stock prices? What about across sectors?

score_data.csv - ACSI scores for a company for a given year stock_data.csv - Stock price data for companies (starting on the first day of the year)

— Preparation —

Load Libraries / Set Options

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0      ✔ purrr   0.3.5 
## ✔ tibble  3.1.8      ✔ dplyr   1.0.10
## ✔ tidyr   1.2.1      ✔ stringr 1.5.0 
## ✔ readr   2.1.3      ✔ forcats 0.5.2 
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## 
## Attaching package: 'magrittr'
## 
## 
## The following object is masked from 'package:purrr':
## 
##     set_names
## 
## 
## The following object is masked from 'package:tidyr':
## 
##     extract
## 
## 
## 
## Attaching package: 'gridExtra'
## 
## 
## The following object is masked from 'package:dplyr':
## 
##     combine
## 
## 
## 
## Attaching package: 'kableExtra'
## 
## 
## The following object is masked from 'package:dplyr':
## 
##     group_rows

Load Data

Load the ACSI score data

score_data <- read_csv("score_data.csv")

kable(score_data) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE) %>%
  column_spec(2, bold = TRUE)
…1 company_name sector publicly_traded ticker 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020
0 FedEx Consumer Shipping Yes FDX 85 86 82 80 83 83 82 82 82 83 84 86 84 85 84 85 83 82 85 82 82 82 82 81 79 80
1 Atmos Energy Investor-Owned Energy Utilities Yes ATO NA NA NA NA NA NA NA NA NA NA NA NA NA 75 78 78 81 83 85 83 82 77 80 80 78 78
3 CenterPoint Energy Investor-Owned Energy Utilities Yes CNP NA NA NA NA NA NA NA NA NA NA 73 72 74 75 78 78 80 82 84 81 81 76 79 82 80 77
4 UPS Consumer Shipping Yes UPS 83 87 82 77 79 81 78 80 79 80 82 83 81 83 82 82 85 81 84 82 82 80 81 82 79 76
5 NextEra Energy Investor-Owned Energy Utilities Yes NEE 77 74 69 75 74 76 73 71 73 76 74 68 73 76 76 75 78 80 80 76 77 76 75 76 77 76
6 Consolidated Edison Investor-Owned Energy Utilities Yes ED 76 74 71 69 73 71 66 74 72 68 68 68 69 66 66 66 72 71 70 69 68 71 79 78 78 75
7 Sempra Energy Investor-Owned Energy Utilities Yes SRE NA NA NA NA NA NA 67 74 77 77 79 75 80 80 80 83 81 83 80 82 79 75 78 77 75 75
8 NiSource Investor-Owned Energy Utilities Yes NI NA NA NA NA NA NA 67 68 66 68 68 66 72 70 71 76 76 81 81 78 78 73 78 78 76 75
9 Southern Company Investor-Owned Energy Utilities Yes SO 78 76 77 79 78 80 80 81 82 81 79 80 82 81 78 78 77 81 83 80 77 76 77 79 77 75
10 Dominion Energy Investor-Owned Energy Utilities Yes D 75 72 74 75 74 75 65 70 72 67 71 70 73 75 72 75 77 80 82 80 78 74 77 78 76 74
11 WEC Energy Investor-Owned Energy Utilities Yes WEC NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 75 75 75 76 74
14 Edison International Investor-Owned Energy Utilities Yes EIX 74 77 78 75 73 78 60 66 69 71 75 78 74 75 77 75 75 76 77 77 76 74 76 76 75 74
15 Xcel Energy Investor-Owned Energy Utilities Yes XEL NA NA NA NA NA NA 65 74 73 70 68 70 71 73 76 72 74 74 76 75 76 71 73 73 74 73
16 CMS Energy Investor-Owned Energy Utilities Yes CMS 76 77 75 73 76 76 75 76 78 71 74 72 73 74 70 75 77 75 79 78 76 71 74 75 73 73
17 Ameren Investor-Owned Energy Utilities Yes AEE NA NA NA NA NA NA 78 76 77 74 75 74 57 64 68 71 71 78 74 76 76 72 74 76 75 73
18 PPL Investor-Owned Energy Utilities Yes PPL NA NA NA NA NA NA 80 80 80 79 80 81 81 78 79 74 79 80 80 79 78 75 77 78 73 73
22 Exelon Investor-Owned Energy Utilities Yes EXC             66 69 71 71 71 70 68 69 70 72 73 70 74 75 69 70 71 72 73 72
23 Entergy Investor-Owned Energy Utilities Yes ETR 76 75 70 70 69 74 69 74 71 73 75 70 73 74 74 73 76 78 81 76 77 70 74 75 75 72
24 Public Service Enterprise Group Investor-Owned Energy Utilities Yes PEG 80 77 75 74 73 78 75 76 76 73 74 75 73 75 76 78 78 77 74 70 72 68 72 72 72 72
25 DTE Energy Investor-Owned Energy Utilities Yes DTE 78 78 75 74 74 75 74 68 72 71 68 65 70 72 71 72 73 72 78 80 74 72 73 73 72 72
26 Duke Energy Investor-Owned Energy Utilities Yes DUK 80 83 79 78 80 79 79 79 77 78 78 80 79 76 77 76 77 79 75 77 72 70 73 73 70 71
27 FirstEnergy Investor-Owned Energy Utilities Yes FE NA NA NA NA NA NA 72 77 76 69 71 75 76 77 74 75 78 76 75 73 79 69 73 73 72 71
28 National Grid Investor-Owned Energy Utilities Yes NGG               73 75 69 72 65 71 71 71 70 NM NM NM NM NM 71 71 73 71 70
29 Eversource Energy Investor-Owned Energy Utilities Yes ES 70 72 67 65 68 72 76 72 73 68 74 72 69 68 72 74 75 59 73 71 66 65 71 70 68 69
30 American Electric Power Investor-Owned Energy Utilities Yes AEP 80 82 77 78 77 79 76 75 74 75 74 75 73 76 74 73 72 79 75 77 74 70 72 73 68 68
31 PG&E Investor-Owned Energy Utilities Yes PCG 71 72 71 68 71 73 49 58 66 66 67 68 72 70 73 70 67 69 74 70 71 72 74 70 70 63
32 Pepco Holdings Investor-Owned Energy Utilities Yes POM NA NA NA NA NA NA NA NA 77 72 73 71 70 69 68 70 54 69 71 73 72 69 NA      
42 Iberdrola Investor-Owned Energy Utilities Yes IBE NA NA NA NA NA NA 73 73 71 70 73 74 70 75 73 72 NA NA NA NA NA NA NA NA    
47 Unilever Personal Care and Cleaning Products Yes UL 83 83 82 83 81 85 83 83 85 85 85 85 86 87 87 87 82 86 85 80 80 84 81 82 80 NA
48 Optimum (Altice USA) Internet Service Providers/Fixed-Line Phone Yes ATUS               NA NA NA NA NA NA NA NA NA NA NA NA NA 61 69 68 64 63 NA
50 Optimum (Altice USA) Fixed-Line Telephone Service Yes ATUS NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 67 72 71 69 69 NA
51 Windstream Fixed-Line Telephone Service Yes WINMQ NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 61 65 65 64 64 NA
53 Vonage Fixed-Line Telephone Service Yes VG NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 73 78 80 76 77 NA
55 Spirit Airlines Yes SAVE NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 54 62 61 62 63 NA
56 Allegiant Airlines Yes ALGT NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 65 65 71 74 71 NA
57 Alaska Airlines Yes ALK NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 75 77 78 79 80 NA
59 Mediacom Internet Service Providers Yes MCCC NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 57 57 58 53 56 NA
61 Mitsubishi Electric & Electronics Televisions and Video Players Yes 6503.T 82 83 81 83 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
62 Allstate Property and Casualty Insurance Yes ALL 73 74 71 73 73 75 76 74 73 76 76 78 78 79 79 78 78 79 77 77 73 77 78 78 78 NA
65 Progressive Property and Casualty Insurance Yes PGR NA NA NA NA NA NA NA NA NA 75 75 73 79 79 80 79 79 81 78 76 74 77 78 78 78 NA
67 Expedia Internet Travel Services Yes EXPE               80 78 76 79 78 75 77 79 79 77 76 NA 76 77 77 80 78 79 NA
68 Mediacom Subscription Television Service Yes MCCC       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 51 54 56 55 56 NA
69 Suddenlink (Altice USA) Subscription Television Service Yes ATUS       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 57 62 63 58 55 NA
72 Frontier Airlines Yes ULCC NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 58 66 63 62 64 NA
73 La Quinta (Wyndham) Hotels Yes LQ NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 76 75 75 76 74 NA
74 PetSmart Specialty Retail Stores Yes PETM       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 77 78 79 79 78 NA
76 Bed Bath & Beyond Specialty Retail Stores Yes BBBY       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 75 79 80 79 80 NA
77 Walmart Health and Personal Care Stores Yes WMT       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 68 68 76 75 73 74 NA
78 Target Health and Personal Care Stores Yes TGT   NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 78 80 79 NA     NA
79 Kroger Health and Personal Care Stores Yes KR   NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 81 81 80 81 78 NA
81 Dollar Tree Department and Discount Stores Yes DLTR NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 79 76 80 77 77 77 NA
82 Audi (Volkswagen) Automobiles and Light Vehicles Yes AUDVF NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 79 78 83 82 83 82 NA
83 Domino’s Limited-Service Restaurants Yes DPZ 70 68 68 70 67 69 73 75 75 NA 71 75 75 75 77 77 77 77 81 80 75 78 78 79 79 NA
86 Big Lots Department and Discount Stores Yes BIG       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 74 77 74 75 73 NA
88 Target Supermarkets Yes TGT NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 71 78 79 78 79 NA
96 Texas Roadhouse Full-Service Restaurants Yes TXRH       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 83 82 82 83 83 NA
97 GameStop Specialty Retail Stores Yes GME       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 78 80 77 74 75 NA
98 Priceline Internet Travel Services Yes PCLN           66 69 71 71 73 72 72 73 72 76 73 76 74 NA 75 75 81 77 78 76 NA
99 CBS Broadcasting Network/Cable TV News Yes CBS 75 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
100 Google Internet Search Engines and Information Yes GOOGL         NA NA NA 80 82 82 82 81 78 86 86 80 83 82 77 83 78 84 82 82 79 NA
103 BMW Automobiles and Light Vehicles Yes BMWYY 81 81 80 86 86 84 86 86 85 84 86 85 86 87 87 86 83 86 82 80 82 85 82 82 82 NA
104 Cadillac (GM) Automobiles and Light Vehicles Yes GM 84 88 84 88 85 86 88 86 87 83 86 84 86 85 89 86 87 86 85 80 80 79 83 82 81 NA
105 Chevrolet (GM) Automobiles and Light Vehicles Yes GM 79 79 78 79 76 80 78 78 79 77 78 81 82 79 83 80 82 84 79 82 79 83 81 79 80 NA
108 Ford Automobiles and Light Vehicles Yes F 79 78 77 77 77 77 78 78 80 76 75 77 80 80 83 82 84 83 83 81 79 81 79 77 77 NA
109 GMC (GM) Automobiles and Light Vehicles Yes GM NA NA 80 78 81 81 79 81 83 80 81 82 82 83 82 84 83 80 85 82 78 84 84 80 78 NA
110 Honda Automobiles and Light Vehicles Yes HMC 86 83 82 81 83 82 83 82 82 85 86 86 84 86 88 84 85 83 86 83 80 86 81 83 82 NA
116 Sprint Wireless Telephone Service Yes S                   59 63 63 61 56 63 70 72 71 71 68 65 70 73 70 69 NA
117 Motorola (Lenovo) Cellular Telephones Yes LNVGY                   70 70 71 72 74 72 76 77 73 77 77 79 77 76 79 80 NA
118 BlackBerry Cellular Telephones Yes BB                   NA NA NA NA NA NA NA NA 69 69 74 78 NA NA NA NA NA
123 NYTimes.com Internet News and Opinion Yes NYT               71 70 72 72 72 73 75 73 76 73 74 74 73 76 76 73 75 76 NA
125 Hyundai Automobiles and Light Vehicles Yes HYMTF 68 69 68 72 68 76 81 78 81 81 84 84 83 83 85 82 83 85 82 81 81 81 83 80 79 NA
126 Jeep (Fiat Chrysler) Automobiles and Light Vehicles Yes FCAU 77 76 74 77 77 75 76 79 79 77 78 77 75 76 79 77 79 83 80 79 75 78 80 80 76 NA
127 Kia Automobiles and Light Vehicles Yes KIMTF NA NA NA NA NA NA NA NA NA NA NA 77 78 80 81 80 81 82 82 82 78 79 82 79 76 NA
131 Buick (GM) Automobiles and Light Vehicles Yes GM 84 84 83 84 86 86 86 86 84 83 84 86 86 85 88 88 85 87 82 83 80 79 80 80 79 NA
133 Sony Televisions and Video Players Yes SNE 84 81 81 82 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
136 Clorox Personal Care and Cleaning Products Yes CLX 88 84 83 85 84 85 85 85 86 88 88 86 87 87 88 86 88 87 85 85 82 84 84 85 82 NA
137 Colgate-Palmolive Personal Care and Cleaning Products Yes CL 86 82 83 82 80 80 85 80 83 82 83 84 81 87 83 85 84 83 85 83 79 83 81 82 82 NA
138 Henkel Personal Care and Cleaning Products Yes HENKY 85 85 83 81 79 85 84 84 85 85 83 83 86 85 84 83 84 83 84 81 79 85 83 82 77 NA
140 Emerson Electric Televisions and Video Players Yes EMR 81 80 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
141 Volvo Automobiles and Light Vehicles Yes VOLV-B 84 84 84 81 80 82 81 82 81 80 81 NA NA NA NA NA NA NA NA NA 79 NA 82 85 82 NA
142 Lexus (Toyota) Automobiles and Light Vehicles Yes TM NA NA NA NA NA NA NA NA NA NA NA 86 87 87 89 85 87 89 87 84 84 84 86 85 84 NA
143 Lincoln (Ford) Automobiles and Light Vehicles Yes F 84 80 81 83 82 85 82 84 81 86 83 83 86 83 88 89 86 90 NA NA 83 87 83 84 82 NA
144 Mazda Automobiles and Light Vehicles Yes MZDAY 77 75 74 77 76 78 78 81 82 78 80 79 78 80 81 80 79 82 82 80 80 80 82 80 77 NA
145 Mercedes-Benz Automobiles and Light Vehicles Yes DDAIF 86 87 87 86 86 87 86 83 83 80 80 82 83 82 86 86 86 85 88 86 83 81 84 82 83 NA
146 Nissan Automobiles and Light Vehicles Yes NSANY 82 80 79 77 79 78 80 80 79 81 78 82 80 82 78 82 84 83 83 81 77 80 80 80 75 NA
150 Subaru Automobiles and Light Vehicles Yes FUJHY 79 83 79 83 NA NA NA NA NA NA NA NA NA NA NA NA NA 87 86 85 82 84 85 84 82 NA
151 Toyota Automobiles and Light Vehicles Yes TM 84 84 84 85 83 82 83 83 85 84 87 87 84 86 86 84 87 85 86 83 82 85 86 83 81 NA
152 Volkswagen Automobiles and Light Vehicles Yes VOW3 76 76 79 78 82 83 81 82 76 80 78 78 80 81 86 81 84 85 84 84 80 78 79 82 77 NA
153 HuffPost (Verizon) Internet News and Opinion Yes VZ               NA NA NA NA NA NA NA NA NA 69 69 69 70 71 72 67 70 70 NA
158 DISH Network Video-on-Demand Service Yes DISH NA NA                                           73 71 NA
160 DIRECTV (AT&T) Video-on-Demand Service Yes T NA NA                                           70 70 NA
163 Xfinity (Comcast) Video-on-Demand Service Yes CMCSA NA NA                                           67 66 NA
164 Spectrum (Charter) Video-on-Demand Service Yes CHTR NA NA                                           64 64 NA
165 Netflix Video Streaming Service Yes NFLX NA NA                                           78 79 NA
167 Twitch (Amazon) Video Streaming Service Yes AMZN NA NA                                           78 75 NA
169 Microsoft Store Video Streaming Service Yes MSFT NA NA                                           77 77 NA
170 YouTube (Google) Video Streaming Service Yes GOOGL NA NA                                           76 75 NA
171 Amazon Prime Video Video Streaming Service Yes AMZN NA NA                                           75 76 NA
172 Netflix Internet Retail Yes NFLX NA NA       NA NA NA NA NA NA NA 84 85 87 86 74 75 79 81 76 79 NA NA NA NA
176 Charles Schwab Financial Advisors Yes SCHW           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA   82 82 82 NA
177 LPL Financial Financial Advisors Yes LPLA           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA   82 78 78 NA
178 Morgan Stanley Financial Advisors Yes MS                                             81 79 79 NA
179 Raymond James Financial Advisors Yes RJF                                             81 81 80 NA
180 Wells Fargo Financial Advisors Yes WFC                                             80 79 79 NA
182 Merrill (Bank of America) Financial Advisors Yes BAC                                             79 79 77 NA
183 UBS Financial Advisors Yes UBS       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 79 80 80 NA
185 O’Reilly Auto Parts Specialty Retail Stores Yes ORLY       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 80 78 NA
186 Foot Locker Specialty Retail Stores Yes FL NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 78 78 79 NA
189 Costco Supermarkets Yes COST NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 83 83 83 NA
190 Sam’s Club (Walmart) Supermarkets Yes WMT NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 82 80 80 NA
194 Home Depot Internet Retail Yes HD       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 79 78 NA
195 Lowe’s Internet Retail Yes LOW       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 79 78 NA
196 Gap Internet Retail Yes GPS       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 78 78 NA
197 Best Buy Internet Retail Yes BBY       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 78 NA
198 Groupon Goods Internet Retail Yes GRPN       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 76 77 NA
199 Staples Internet Retail Yes SPLS       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 76 77 NA
200 Walgreens Internet Retail Yes WBA       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 76 75 NA
201 GameStop Internet Retail Yes GME       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 75 76 NA
202 Walmart Internet Retail Yes WMT       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 74 74 NA
204 Ulta Beauty Specialty Retail Stores Yes ULTA       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 80 NA
206 TripAdvisor Internet Travel Services Yes TRIP       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 82 NA
207 Frontier Communications Video-on-Demand Service Yes FTR       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 67 NA
209 Snapchat Internet Social Media Yes SNAP       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 71 NA
210 Dell Internet Retail Yes DELL       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 79 78 NA
211 Wayfair Internet Retail Yes W       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 80 NA
212 Target Internet Retail Yes TGT       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 78 NA
220 Ram (Fiat Chrysler) Automobiles and Light Vehicles Yes RAM NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 80 NA
221 Costco Internet Retail Yes COST           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 83 81 NA
222 Etsy Internet Retail Yes ETSY           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 82 NA
223 Kohl’s Internet Retail Yes KSS           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 81 NA
224 Nike Internet Retail Yes NKE           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 81 NA
225 Nordstrom Internet Retail Yes JWN           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 82 NA
226 Apple Internet Retail Yes AAPL           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 78 NA
227 HP Store Internet Retail Yes HPQ           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 81 NA
228 Macy’s Internet Retail Yes M           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 80 NA
229 TD Ameritrade Financial Advisors Yes AMTD       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 NA
231 LG Household Appliances Yes 066570.KS NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 82 85 83 82 82 NA
233 Amazon Personal Computers and Internet Retail Yes AMZN NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 78 80 79 82 79 NA
234 Samsung Personal Computers and Household Appliances Yes 005930.KS NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 78 83 82 82 81 NA
235 ASUS Personal Computers Yes 2357.TW NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 78 80 78 76 NA
236 Lenovo Personal Computers Yes 0992.HK NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 74 76 76 77 74 NA
237 Regions Bank Banks Yes RF NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 79 78 81 79 78 NA
238 BB&T Banks Yes BBT NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 82 80 79 80 NA
239 Capital One Banks Yes COF NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 80 80 81 79 NA
240 U.S. Bank Banks Yes USB NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 76 77 80 79 79 NA
241 Fifth Third Bank Banks Yes FITB NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 75 81 76 75 78 NA
242 TD Bank Banks Yes TD NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 75 79 80 80 77 NA
243 SunTrust Bank Banks Yes STI NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 74 80 80 81 76 NA
244 Citizens Bank Banks Yes CFG NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 70 80 77 78 78 NA
245 Humana Health Insurance Yes HUM NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 71 72 79 78 79 NA
247 Samsung Household Appliances Yes 005930.KS NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 84 78 80 80 NA
248 Fiat (Fiat Chrysler) Automobiles and Light Vehicles Yes FCAU NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 73 NA 75 78 77 NA
250 Cracker Barrel Full-Service Restaurants Yes CBRL       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 83 84 81 82 NA
251 Red Robin Full-Service Restaurants Yes RRGB       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 80 73 79 79 NA
253 Denny’s Full-Service Restaurants Yes DENN       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 75 74 76 77 77 NA
256 Chipotle Mexican Grill Limited-Service Restaurants Yes CMG NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 83 78 79 79 80 NA
257 Panera Bread Limited-Service Restaurants Yes PNRA (previously) NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 81 82 81 81 NA
259 Jack in the Box Limited-Service Restaurants Yes JACK NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 72 74 75 74 75 NA
262 Instagram (Facebook) Internet Social Media Yes FB NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 76 74 75 72 72 NA
264 Infiniti (Nissan) Automobiles and Light Vehicles Yes 7201.T NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 84 NA 78 82 NA
265 Mitsubishi Automobiles and Light Vehicles Yes 7211.T NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 79 78 79 76 NA
266 Cigna Health Insurance Yes CI NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 60 67 66 73 72 NA
268 Primerica Life Insurance Yes PRI NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 75 74 78 NA NA
269 Albertsons Companies Health and Personal Care Stores Yes ACI NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 69 83 78 78 75 NA
270 Petco Specialty Retail Stores Yes WOOF NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 76 78 77 78 77 NA
271 Burlington Specialty Retail Stores Yes BURL       NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 76 79 77 76 76 NA
272 L Brands Specialty Retail Stores Yes LB           NA NA NA NA NA NA NA NA NA NA NA NA NA NA 83 81 81 85 82 82 NA
273 AutoZone Specialty Retail Stores Yes AZO           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 75 80 78 78 77 NA
274 Advance Auto Parts Specialty Retail Stores Yes AAP           NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 72 79 79 78 78 NA
275 Abercrombie & Fitch Specialty Retail Stores Yes ANF NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 65 76 79 78 79 NA
278 Windstream Internet Service Providers Yes WINMQ NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 59 57 56 57 NA
280 U.S. Cellular Wireless Telephone Service Yes USM NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 72 74 74 74 NA
281 Johnson & Johnson Personal Care and Cleaning Products Yes JNJ NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 82 81 82 77 NA
283 Dick’s Sporting Goods Specialty Retail Stores Yes DKS NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 79 78 75 76 NA
284 Ahold Delhaize Supermarkets Yes AD NA NA NA NA                                   76 79 78 77 NA
286 Ross Stores Department and Discount Stores Yes ROST NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 74 76 76 77 76 NA
288 Allstate Life Insurance Yes ALL NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 82 79 75 81 NA
291 Lincoln Financial Life Insurance Yes LNC NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 75 76 76 78 78 NA
292 Farmers Life Insurance Yes FMNB NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 71 80 77 74 81 NA
295 Nationwide Property and Casualty Insurance Yes NFS NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 75 79 76 80 NA NA
298 Travelers Property and Casualty Insurance Yes TRV NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 73 77 80 78 NA NA
300 Scottrade (TD Ameritrade) Internet Investment Services Yes AMTD NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 79 83 77 NA   NA
302 Merrill Edge (Bank of America) Internet Investment Services Yes BAC NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 73 79 77 79 74 NA
304 Verizon Communications Fixed-Line Telephone Service Yes VZ   NA NA NA     73 71 73 73 70 69 72 70 71 73 71 70 74 73 68 72 73 72 73 NA
307 DIRECTV (AT&T) Subscription Television Service Yes T             70 70 72 71 67 71 67 68 71 68 69 68 72 69 68 68 68 64 66 NA
308 DISH Network Subscription Television Service Yes DISH             71 68 71 71 68 68 67 65 64 71 67 69 70 67 67 67 67 67 67 NA
309 Time Warner Cable (Charter Communications) Subscription Television Service Yes CHTR             63 61 61 60 61 61 58 59 59 61 59 63 60 56 51 59 60 NA   NA
311 AT&T Wireless Telephone Service Yes T                   63 62 63 68 71 67 69 66 69 70 68 70 71 72 74 74 NA
314 T-Mobile Wireless Telephone Service Yes TMUS                   NA 64 69 70 71 71 73 70 69 68 69 70 74 73 76 76 NA
316 Kyocera Cellular Telephones Yes 6971.T                   70 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
318 Samsung Cellular Telephones Yes 005930.KS NA NA NA             73 71 73 70 71 70 76 74 71 76 81 80 80 80 80 81 NA
321 Spectrum (Charter Communications) Subscription Television Service Yes CHTR   NA NA       63 53 55 56 56 55 55 54 51 60 59 59 64 60 63 60 63 58 59 NA
322 Universal Studios Motion Pictures Yes CMCSA 74 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
323 Walt Disney Motion Pictures Yes DIS 80 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
327 AT&T Fixed-Line Telephone Service Yes T 83 83 80 81 79 75 73 73 76 76 72 71 70 75 71 75 71 70 73 72 65 70 71 72 72 NA
329 Gannett Newspapers Yes GCI 66 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
331 New York Times Newspapers Yes NYT 70 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
334 U-verse TV (AT&T) Subscription Television Yes T   NA NA       NA NA NA NA NA NA NA NA NA 72 68 68 71 69 69 69 70 70 69 NA
337 Olive Garden (Darden) Full-Service Restaurants Yes DRI                         80 82 81 84 82 80 83 80 79 81 81 80 79 NA
338 McDonald’s Limited-Service Restaurants Yes MCD 63 60 60 61 61 59 62 61 64 NA 62 63 64 69 70 67 72 73 73 71 67 69 69 69 69 NA
339 Papa John’s Limited-Service Restaurants Yes PZZA NA NA NA NA 76 77 78 76 76 NA 78 79 77 76 75 80 79 83 82 82 78 82 82 80 80 NA
340 Pizza Hut (Yum! Brands) Limited-Service Restaurants Yes YUM 66 63 71 71 68 70 71 70 75 NA 71 76 72 76 74 78 81 78 80 82 78 77 76 80 80 NA
341 Starbucks Limited-Service Restaurants Yes SBUX NA NA NA NA NA NA NA NA NA NA NA 77 78 77 76 78 80 76 80 76 74 75 77 78 79 NA
342 Taco Bell (Yum! Brands) Limited-Service Restaurants Yes YUM 66 66 67 64 64 63 66 67 68 NA 72 70 69 70 73 74 76 77 74 72 72 75 76 74 75 NA
343 Wendy’s Limited-Service Restaurants Yes WEN 73 71 69 73 71 70 72 74 74 NA 75 76 78 73 76 77 77 78 79 78 73 76 76 77 77 NA
344 American Airlines Yes AAL 71 71 62 67 64 63 62 63 67 66 64 62 60 62 60 63 63 64 65 66 66 72 76 74 73 NA
346 Delta Airlines Yes DAL 72 67 69 65 68 66 61 66 67 67 65 64 59 60 64 62 56 65 68 71 71 71 76 74 75 NA
348 Southwest Airlines Yes LUV 76 76 76 74 72 70 70 74 75 73 74 74 76 79 81 79 81 77 81 78 78 80 80 80 79 NA
349 United Airlines Yes UAL 67 70 68 65 62 62 59 64 63 64 61 63 56 56 56 60 61 62 62 60 60 68 70 67 70 NA
351 Facebook Internet Social Media Yes FB                               64 66 61 62 67 75 68 68 67 63 NA
353 KFC (Yum! Brands) Limited-Service Restaurants Yes YUM 68 69 67 64 64 65 63 69 71 NA 69 70 71 70 69 75 75 75 81 74 73 78 78 77 78 NA
354 Outback Steakhouse Full-Service Restaurants Yes BLMN                         79 76 77 80 81 81 81 80 78 77 80 79 79 NA
355 Red Lobster Full-Service Restaurants Yes DRI                         78 79 80 83 82 83 83 78 77 79 81 79 78 NA
356 Best Western Hotels Yes BW 70 NA NA NA NA NA NA NA NA NA NA NA NA 70 75 76 76 76 79 74 74 75 76 77 77 NA
357 Choice Hotels Yes CHH NA NA NA NA NA NA NA NA NA NA NA NA NA 71 76 74 74 76 75 74 73 74 74 73 74 NA
358 Hilton Hotels Yes HLT 75 75 75 72 74 77 74 76 74 77 76 78 76 78 79 80 80 80 80 78 80 81 81 82 80 NA
359 Holiday Inn Hotels Yes HLT 69 NA NA 69 68 71 71 69 72 73 69 72 72 NA                       NA
360 Hyatt Hotels Yes H 75 77 77 75 73 74 73 75 77 74 74 75 77 78 74 79 77 76 79 78 80 79 80 79 79 NA
361 InterContinental Hotels Yes IHG NA NA NA NA NA NA NA NA NA NA NA NA NA 74 75 78 76 77 78 78 76 76 78 77 78 NA
362 Marriott Hotels Yes MAR 76 77 76 76 77 74 77 76 76 76 76 75 79 78 77 80 79 78 82 81 80 80 80 81 80 NA
365 Starwood (Marriott) Hotels Yes HOT NA NA NA NA NA 73 71 69 73 73 75 75 76 74 74 77 79 75 78 76 76 78 79 79 NA NA
366 Wyndham Hotels Yes WH NA NA NA NA NA NA NA NA NA NA NA NA NA 70 70 70 73 70 72 72 68 70 71 70 70 NA
367 Burger King Limited-Service Restaurants Yes BKW 65 67 68 64 66 67 65 68 68 NA 71 70 69 71 69 74 75 75 76 76 72 76 77 76 76 NA
370 Charles Schwab Internet Investment Services Yes SCHW           76 72 76 75 71 74 80 82 78 79 80 79 77 84 80 78 81 80 79 81 NA
371 Chevron Gasoline Stations Yes CVX 81 78 77 81 76 76 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
372 Exxon Gasoline Stations Yes XOM 80 79 78 80 NA   NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
373 Exxon Mobil Gasoline Stations Yes XOM         77 75 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
376 Shell Oil Gasoline Stations Yes RDS.A 80 77 81 78 75 77 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
379 Barnes & Noble Specialty Retail Stores Yes BKS             NA NA NA NA NA NA 83 83 84 82 79 82 82 81 79 81 81 81 81 NA
380 Best Buy Specialty Retail Stores Yes BBY             NA NA 72 72 71 76 74 74 74 77 77 78 77 77 74 77 78 78 77 NA
383 Costco Department and Discount Stores Yes COST         79 77 76 79 80 79 79 81 81 83 81 82 83 83 84 84 81 83 83 83 83 NA
384 Gap Specialty Retail Stores Yes GPS             NA NA NA NA NA NA 75 75 75 74 77 76 77 75 75 79 77 78 79 NA
386 BP Gasoline Stations Yes BP NA NA NA 81 NA   NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
387 E*Trade Internet Investment Services Yes ETFC           66 66 69 71 70 71 74 73 69 74 76 79 73 76 76 74 80 79 79 78 NA
389 TD Ameritrade Internet Investment Services Yes AMTD           NA NA NA NA NA NA 77 80 71 76 77 78 77 74 74 73 78 79 77 79 NA
390 1-800-FLOWERS.COM Internet Retail Yes FLWS           69 76 78 76 79 77 77 NA NA NA NA NA NA NA NA NA NA NA NA NA NA
391 Amazon Internet Retail Yes AMZN           84 84 88 88 84 87 87 88 86 86 87 86 85 88 86 83 86 85 82 83 NA
394 eBay Internet Retail Yes EBAY           80 82 82 84 80 81 80 81 78 79 81 81 83 80 79 75 81 81 80 79 NA
397 Overstock Internet Retail Yes OSTK           NA NA NA NA NA NA NA 80 82 82 83 83 81 79 77 73 79 81 80 79 NA
401 Home Depot Specialty Retail Stores Yes HD             75 71 73 73 67 70 67 70 72 75 78 77 79 76 73 80 76 76 78 NA
402 Lowe’s Specialty Retail Stores Yes LOW             75 76 77 76 78 74 75 76 79 77 79 79 82 81 74 79 78 78 78 NA
404 Microsoft Computer Software Yes MSFT                       73 70 69 70 76 78 75 74 75 75 80 76 79 77 NA
406 CenturyLink Fixed-Line Telephone Service Yes CTL 83 80 76 76 74 70 71 74 73 65 66 64 66 70 68 70 70 66 71 71 70 68 66 66 65 NA
416 Fox Entertainment Motion Pictures Yes FOX 79 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
417 Whole Foods (Amazon) Supermarkets Yes WFM NA NA NA NA NA NA NA NA NA NA NA NA 73 75 76 79 80 80 78 81 73 81 81 79 79 NA
418 Walmart Supermarkets Yes WMT NA NA NA NA NA NA NA NA NA 70 70 69 71 68 71 71 69 72 72 71 67 74 73 72 73 NA
419 Office Depot Specialty Retail Stores Yes ODP             NA NA NA NA NA NA 78 75 76 81 79 84 79 78 NA 79 77 77 76 NA
421 Sam’s Club (Walmart) Department and Discount Stores Yes WMT   75 72 75 78 74 78 77 77 75 76 78 77 79 79 78 81 80 80 80 76 81 80 80 81 NA
423 TJX Specialty Retail Stores Yes TJX             NA NA NA NA NA NA 74 73 78 76 78 76 79 78 78 80 80 79 79 NA
424 Albertsons Companies Supermarkets Yes ACI 77 77 72 70 73 70 72 73 73 69 71 NA NA NA NA NA NA NA NA 74 68 75 76 75 75 NA
428 Kroger Supermarkets Yes KR 76 74 74 73 74 71 75 75 71 73 74 76 75 77 78 78 79 79 80 78 76 79 81 79 79 NA
435 Chase Banks Yes JPM   NA NA             70 70 72 74 73 68 67 70 74 76 74 71 75 79 80 79 NA
437 HCA Hospitals Yes HCA 73 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
440 Apple Cellular Telephones Yes AAPL       NA NA NA NA NA NA NA NA NA NA NA NA NA NA 83 81 79 80 81 81 81 81 NA
444 Dunkin’ Limited-Service Restaurants Yes DNKN NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 79 80 75 78 80 79 78 78 NA
445 JetBlue Airlines Yes JBLU NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 81 83 79 81 80 82 79 79 NA
447 Pinterest Internet Social Media Yes PINS       NA NA NA NA NA NA NA NA NA NA NA NA NA NA 69 72 76 78 76 78 80 80 NA
448 Twitter Internet Social Media Yes TWTR       NA NA NA NA NA NA NA NA NA NA NA NA NA NA 64 65 69 71 65 70 66 69 NA
449 LinkedIn (Microsoft) Internet Social Media Yes MSFT       NA NA NA NA NA NA NA NA NA NA NA NA NA NA 63 62 67 68 65 65 66 69 NA
450 Travelers Group Life Insurance Yes TRV NA                                                 NA
451 Prudential Life Insurance Yes PRU 74 68 70 71 69 71 76 74 73 77 72 76 77 79 77 77 79 79 78 79 77 77 78 77 78 NA
452 KeyBank Banks Yes KEY 76 70 65 65 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 80 75 77 76 NA
455 PNC Bank Banks Yes PNC NA 69 69 66 NA 67 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 78 78 78 78 79 NA
457 Wells Fargo Banks Yes WFC 71 65 62 67 65 67 66 69 68 70 67 72 69 72 73 73 73 71 72 72 75 76 74 74 76 NA
458 Aetna (CVS Health) Health Insurance Yes CVS             64 65 66 63 65 65 66 65 70 68 67 67 69 65 68 75 74 75 76 NA
460 UnitedHealth Health Insurance Yes UNH             66 68 64 66 64 68 65 63 72 65 72 70 70 72 66 70 73 73 75 NA
461 Anthem Health Insurance Yes ANTM             NA NA NA NA NA 69 66 68 67 69 74 70 73 66 69 75 NA NA NA NA
463 MetLife Life Insurance Yes MET 73 74 75 76 73 72 74 75 77 77 71 78 76 78 77 78 77 78 77 76 75 76 77 81 79 NA
466 Toshiba Personal Computers Yes TOSBF NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 77 78 75 73 76 75 71 77 NA
467 Dillard’s Department and Discount Stores Yes DDS 74 74 73 71 68 72 75 75 75 77 76 75 76 75 78 78 80 79 81 81 80 83 79 79 78 NA
468 Target (Discount Stores) Department and Discount Stores Yes TGT 76 77 73 74 74 73 77 78 77 NA                               NA
469 CVS Health and Personal Care Stores Yes CVS                     74 78 76 77 77 74 73 75 76 75 71 76 78 77 77 NA
471 Walgreens Health and Personal Care Stores Yes WBA                     76 76 78 77 77 77 75 76 76 77 74 76 77 77 75 NA
472 Procter & Gamble Personal Care and Cleaning Products Yes PG 87 85 81 83 81 84 82 81 85 86 82 84 85 85 85 82 82 82 84 82 75 83 82 82 84 NA
473 Acura (Honda) Automobiles and Light Vehicles Yes HMC NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 83 77 83 76 80 81 78 NA
474 Spectrum (Charter Communications) Fixed-Line Telephone Service Yes CHTR NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 72 69 69 65 71 66 67 NA
478 Spectrum (Charter Communications) Internet Service Providers Yes CHTR                                     65 61 57 63 65 60 59 NA
479 CenturyLink Internet Service Providers Yes CTL                                     64 65 60 63 59 58 59 NA
481 Xfinity (Comcast) Internet Service Providers Yes CMCSA                                     62 57 56 59 60 60 61 NA
482 Target (Department Stores) Department and Discount Stores Yes TGT 76 74 72 74 72 72 74 75 73 NA                               NA
484 Dollar General Department and Discount Stores Yes DG NA NA NA NA NA NA NA NA NA NA NA NA 78 75 79 80 78 78 80 75 74 78 73 73 73 NA
486 Macy’s Department and Discount Stores Yes M                     74 71 75 74 71 76 77 78 76 79 73 79 77 77 78 NA
487 Kohl’s Department and Discount Stores Yes KSS NA NA NA NA NA NA NA 84 79 79 80 80 79 80 79 81 81 81 81 80 77 79 79 79 79 NA
488 Nordstrom Department and Discount Stores Yes JWN 83 82 80 79 76 76 76 NA NA NA NA NA 80 80 83 82 84 84 83 86 82 80 81 79 79 NA
490 Target Department and Discount Stores Yes TGT                   75 78 77 77 77 80 78 80 81 77 80 75 79 77 77 78 NA
491 Walmart Department and Discount Stores Yes WMT 81 74 76 75 72 73 75 74 75 73 72 72 68 70 71 73 70 71 71 68 66 72 71 72 71 NA
498 ABC Network/Cable TV News Yes DIS 77 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
500 YouTube (Google) Internet Social Media Yes GOOGL                               73 74 73 71 73 76 77 74 75 78 NA
501 Philip Morris Cigarettes Yes PM 81 79 77 75 75 75 75 74 76 78 78 77 76 79 72 77 80 80 NA NA NA NA NA NA NA NA
503 Coca-Cola Soft Drinks Yes KO 85 87 84 82 84 86 81 85 83 83 84 82 84 85 84 84 85 84 84 83 79 81 85 81 81 NA
504 Keurig Dr Pepper Soft Drinks Yes KDP 85 86 83 88 85 86 85 86 89 84 83 86 86 87 86 85 82 87 86 82 79 86 82 84 82 NA
505 PepsiCo Soft Drinks Yes PEP 87 86 83 83 82 85 84 86 83 83 82 86 84 84 86 84 85 84 85 83 78 84 85 80 82 NA
507 Hanesbrands Apparel Yes HBI 81 75 81 77 78 78 76 78 80 79 79 82 82 80 82 81 82 79 81 78 74 81 79 82 80 NA
509 Levi Strauss Apparel Yes LEVI 83 80 81 75 76 79 80 78 80 80 79 79 80 78 83 81 81 82 82 80 78 81 81 79 77 NA
511 VF Apparel Yes VFC 80 80 81 79 78 82 84 82 84 79 82 82 84 83 81 85 83 82 81 84 76 80 80 82 79 NA
512 Adidas Athletic Shoes Yes ADS.DE 80 77 74 74 75 78 73 76 74 77 75 78 77 78 78 82 80 77 80 77 77 83 81 78 83 NA
513 Nike Athletic Shoes Yes NKE 78 77 74 73 73 78 74 76 76 78 75 72 75 78 79 80 80 80 78 78 78 80 79 77 81 NA
517 Electrolux Household Appliances Yes ELUX-B NA NA NA NA NA NA NA NA NA NA NA 80 81 80 79 79 78 82 78 79 81 81 81 78 79 NA
521 Whirlpool Household Appliances Yes WHR 82 85 82 85 84 86 83 83 82 83 81 82 84 80 83 83 82 83 82 81 80 81 80 79 80 NA
522 Acer Personal Computers Yes ACIDF NA NA NA NA NA NA NA NA NA NA NA NA NA 72 74 77 77 79 77 76 70 78 75 75 77 NA
523 Apple Personal Computers Yes AAPL 75 76 70 69 72 75 73 73 77 81 81 83 79 85 84 86 87 86 87 84 84 84 83 83 83 NA
525 Dell Personal Computers Yes DELL NA NA 72 74 76 80 78 76 78 79 74 78 74 75 75 77 77 81 79 76 78 78 76 73 77 NA
526 HP Personal Computers Yes HPQ 80 77 75 72 74 74 73 71 70 71 73 75 76 73 74 77 78 79 80 74 73 77 77 78 78 NA
529 Anheuser-Busch InBev Breweries Yes BUD 80 79 81 81 78 81 80 82 82 79 82 81 82 82 85 82 81 81 81 77 74 84 84 85 84 NA
530 Molson Coors Breweries Yes TAP 84 79 80 84 78 82 78 79 80 78 82 83 82 83 81 81 81 NA         84 81 81 NA
532 Campbell Soup Food Manufacturing Yes CPB 81 84 81 80 81 81 81 80 83 79 81 80 83 80 82 82 79 81 84 83 79 80 80 81 81 NA
534 Hill’s Pet Nutrition (Colgate-Palmolive) Pet Food Yes CL     85 83 86 82 84 84 85 83 82 83 85 81 80 82 84 83 NA NA NA NA NA NA NA NA
535 Iams (Procter & Gamble) Pet Food Yes PG     NA NA NA NA 80 82 85 82 81 83 82 81 85 80 81 83 NA NA NA NA NA NA NA NA
537 Nestle Pet Food Yes NSRGF     83 83 84 81 81 NA                                   NA
540 Bank of America Banks Yes BAC 67 65 61 62 61 63 68 70 74 72 72 72 72 73 67 68 68 66 69 69 68 75 77 76 77 NA
548 Tyson Food Manufacturing Yes TSN 80 79 80 79 79 81 80 80 81 79 79 78 78 80 82 77 79 81 80 79 78 82 80 81 80 NA
549 Conagra Food Manufacturing Yes CAG 83 82 80 80 80 82 81 83 84 82 86 83 83 84 78 83 83 84 83 82 80 80 82 81 81 NA
551 General Mills Food Manufacturing Yes GIS 81 86 81 82 81 82 83 83 83 84 82 84 83 84 83 83 83 83 87 85 78 84 82 84 82 NA
553 Hershey Food Manufacturing Yes HSY 88 88 84 84 86 85 86 87 85 87 86 86 87 85 87 86 84 85 86 86 79 84 86 86 84 NA
554 Kellogg Food Manufacturing Yes K 84 85 81 83 81 83 83 81 82 81 81 85 83 85 85 81 80 83 85 81 80 81 81 81 80 NA
555 Kraft Heinz Food Manufacturing Yes KHC 84 85 82 84 83 82 82 81 83 84 84 86 84 85 83 81 83 81 86 84 79 83 82 82 81 NA
558 Nestle (Ferrero) Food Manufacturing Yes NSRGF 86 82 83 83 81 84 83 83 83 83 83 84 83 83 85 84 84 85 83 85 78 84 82 82 81 NA
560 Quaker (PepsiCo) Food Manufacturing Yes PEP 82 82 85 83 83 86 86 87 86 86 88 85 86 87 87 86 84 86 87 85 80 83 84 84 84 NA
score_data
## # A tibble: 318 × 31
##     ...1 compa…¹ sector publi…² ticker `1995` `1996` `1997` `1998` `1999` `2000`
##    <dbl> <chr>   <chr>  <chr>   <chr>  <chr>  <chr>  <chr>  <chr>  <chr>  <chr> 
##  1     0 FedEx   Consu… Yes     FDX    85     86     82     80     83     83    
##  2     1 Atmos … Inves… Yes     ATO    <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  3     3 Center… Inves… Yes     CNP    <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  4     4 UPS     Consu… Yes     UPS    83     87     82     77     79     81    
##  5     5 NextEr… Inves… Yes     NEE    77     74     69     75     74     76    
##  6     6 Consol… Inves… Yes     ED     76     74     71     69     73     71    
##  7     7 Sempra… Inves… Yes     SRE    <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  8     8 NiSour… Inves… Yes     NI     <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  9     9 Southe… Inves… Yes     SO     78     76     77     79     78     80    
## 10    10 Domini… Inves… Yes     D      75     72     74     75     74     75    
## # … with 308 more rows, 20 more variables: `2001` <chr>, `2002` <chr>,
## #   `2003` <chr>, `2004` <chr>, `2005` <chr>, `2006` <chr>, `2007` <chr>,
## #   `2008` <chr>, `2009` <chr>, `2010` <chr>, `2011` <chr>, `2012` <chr>,
## #   `2013` <chr>, `2014` <chr>, `2015` <chr>, `2016` <chr>, `2017` <chr>,
## #   `2018` <chr>, `2019` <chr>, `2020` <chr>, and abbreviated variable names
## #   ¹​company_name, ²​publicly_traded

How many unique company tickers are in the dataset?

score_data %>% pull(ticker) %>% unique() %>% length()
## [1] 235

gather() the data

score_data_long <- gather(score_data %>% select(-`...1`, -publicly_traded), year, score, -ticker, -company_name, -sector, na.rm = TRUE)
score_data_long$score <- as.numeric(score_data_long$score) #convert score from chr to numeric value
## Warning: NAs introduced by coercion
score_data_long
## # A tibble: 4,966 × 5
##    company_name         sector                          ticker year  score
##    <chr>                <chr>                           <chr>  <chr> <dbl>
##  1 FedEx                Consumer Shipping               FDX    1995     85
##  2 UPS                  Consumer Shipping               UPS    1995     83
##  3 NextEra Energy       Investor-Owned Energy Utilities NEE    1995     77
##  4 Consolidated Edison  Investor-Owned Energy Utilities ED     1995     76
##  5 Southern Company     Investor-Owned Energy Utilities SO     1995     78
##  6 Dominion Energy      Investor-Owned Energy Utilities D      1995     75
##  7 Edison International Investor-Owned Energy Utilities EIX    1995     74
##  8 CMS Energy           Investor-Owned Energy Utilities CMS    1995     76
##  9 Exelon               Investor-Owned Energy Utilities EXC    1995     NA
## 10 Entergy              Investor-Owned Energy Utilities ETR    1995     76
## # … with 4,956 more rows

Load the corresponding stock data

stock_data <- read_csv("stock_data.csv")
names(stock_data)[1] <- "ticker" #rename index to ticker 
stock_data
## # A tibble: 201 × 28
##    ticker `1995` `1996` `1997` `1998` `1999` `2000` `2001` `2002` `2003` `2004`
##    <chr>   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
##  1 FDX     15.1   18.3   22.2   30.5   44.5   42.4   39.5   51.7   54.4   67.7 
##  2 ATO     16.9   22.9   24     29.6   32.5   20     24.5   21.2   23.5   24.5 
##  3 CNP     15.0   20.3   19.1   22.4   27.2   19.2   36.7   22.6    8.56   9.66
##  4 NEE      4.36   5.77   5.75   7.41   7.67   5.30   8.86   7.03   7.54   8.18
##  5 ED      25.9   32     28.8   41     52.8   34.4   38.3   40.1   43.0   43.1 
##  6 NI       5.82   7.49   7.78   9.69  12.0    7.00  12.0    9.08   7.85   8.57
##  7 SO      12.2   15.0   13.9   15.9   17.8   14.1   20.0   25.3   28.5   30.2 
##  8 D       17.9   20.5   19.2   21.2   23.4   19.5   32.9   30     27.5   31.9 
##  9 WEC     12.9   15.2   13.4   14.4   15.6    9.75  11.3   11.3   12.6   16.6 
## 10 EIX     14.6   17.5   20     27.2   28     25.5   15.5   15.1   11.9   21.7 
## # … with 191 more rows, and 17 more variables: `2005` <dbl>, `2006` <dbl>,
## #   `2007` <dbl>, `2008` <dbl>, `2009` <dbl>, `2010` <dbl>, `2011` <dbl>,
## #   `2012` <dbl>, `2013` <dbl>, `2014` <dbl>, `2015` <dbl>, `2016` <dbl>,
## #   `2017` <dbl>, `2018` <dbl>, `2019` <dbl>, `2020` <dbl>, `2021` <dbl>

Merge the score data and price data together by ticker

# gather() the data so it can be merged
stock_data_long <- gather(stock_data, year, price, -ticker, na.rm = TRUE)

# left_join() to combine the two 
analysis_data <- score_data_long %>% mutate(ticker_year = paste0(ticker, "_", year)) %>% left_join(stock_data_long %>% mutate(ticker_year = paste0(ticker, "_", year)) %>% select(-ticker, -year), by=c("ticker_year"="ticker_year")) %>% select(-ticker_year)
analysis_data
## # A tibble: 4,966 × 6
##    company_name         sector                          ticker year  score price
##    <chr>                <chr>                           <chr>  <chr> <dbl> <dbl>
##  1 FedEx                Consumer Shipping               FDX    1995     85 15.1 
##  2 UPS                  Consumer Shipping               UPS    1995     83 NA   
##  3 NextEra Energy       Investor-Owned Energy Utilities NEE    1995     77  4.36
##  4 Consolidated Edison  Investor-Owned Energy Utilities ED     1995     76 25.9 
##  5 Southern Company     Investor-Owned Energy Utilities SO     1995     78 12.2 
##  6 Dominion Energy      Investor-Owned Energy Utilities D      1995     75 17.9 
##  7 Edison International Investor-Owned Energy Utilities EIX    1995     74 14.6 
##  8 CMS Energy           Investor-Owned Energy Utilities CMS    1995     76 23   
##  9 Exelon               Investor-Owned Energy Utilities EXC    1995     NA  8.74
## 10 Entergy              Investor-Owned Energy Utilities ETR    1995     76 21.9 
## # … with 4,956 more rows

Data Exploration

How many companies per sector?

ggplot(score_data, aes(x = sector)) +
  geom_bar(fill = "steelblue") +
  labs(title = "Publicly Traded Companies w/ ACSI Data by Sector", x = "Sector", y = "Count") +
  geom_text(stat = "count", aes(label = ..count..), hjust = -1, color="black", size=2) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) + 
  coord_flip() +
  theme_bw()
## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.

What does satisfaction look like across all sectors over all dates available?

score_data_long %>% ggplot(aes(color=sector, y = score, x=reorder(sector,score,na.rm = TRUE))) + geom_boxplot(alpha=0.4) + geom_jitter(size=0.4, alpha=0.9) + theme_bw() +
    theme(axis.text.x = element_text(angle = 0, vjust = 0.5)) + coord_flip() + theme(legend.position = "none") + ggtitle(paste0("")) + ylab("ACSI Score") + xlab("")  +
  ylim(c(45, 100))
## Warning: Removed 999 rows containing non-finite values (`stat_boxplot()`).
## Warning: Removed 999 rows containing missing values (`geom_point()`).

What sectors have the highest satisfaction scores across all the years available?

Calculate the mean score for each sector by year, then take the average across years and rank them

sector_year_means <- score_data_long %>% 
  group_by(year, sector) %>% 
  summarize(mean_score = mean(score, na.rm = TRUE))
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
sector_means <- sector_year_means %>% 
  group_by(sector) %>% 
  summarize(mean_score = mean(mean_score, na.rm = TRUE)) 

#arrange from top to bottom
sector_means <- sector_means %>% 
  arrange(desc(mean_score))

sector_means %>% 
  mutate(rank = row_number(desc(mean_score)))
## # A tibble: 50 × 3
##    sector                                      mean_score  rank
##    <chr>                                            <dbl> <int>
##  1 Soft Drinks                                       84       1
##  2 Personal Care and Cleaning Products               83.5     2
##  3 Pet Food                                          82.7     3
##  4 Food Manufacturing                                82.7     4
##  5 Consumer Shipping                                 82.0     5
##  6 Household Appliances                              81.9     6
##  7 Televisions and Video Players                     81.8     7
##  8 Automobiles and Light Vehicles                    81.7     8
##  9 Internet Search Engines and Information           81.5     9
## 10 Personal Computers and Household Appliances       81.2    10
## # … with 40 more rows

Average stock price for companies with satisfaction data per year?

Add in S&P 500 stock price information

sp_500_data <- read_csv("sp_500_stock_df.csv")
## New names:
## Rows: 1 Columns: 28
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (1): ...1 dbl (27): 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
## 2005, ...
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`
names(sp_500_data)[1] <- "ticker"
sp_500_data <- gather(sp_500_data, year, price, -ticker, na.rm = TRUE)
sp_500_data
## # A tibble: 27 × 3
##    ticker year  price
##    <chr>  <chr> <dbl>
##  1 SPY    1995   45.7
##  2 SPY    1996   61.4
##  3 SPY    1997   74.4
##  4 SPY    1998   97.3
##  5 SPY    1999  123. 
##  6 SPY    2000  148. 
##  7 SPY    2001  132  
##  8 SPY    2002  115. 
##  9 SPY    2003   88.8
## 10 SPY    2004  112. 
## # … with 17 more rows
# Sort the dataframe by ticker and year
stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),]

# Mark both data types
stock_data_long$type <- "ACSI Surveyed Companies"
sp_500_data$type <- "S&P 500"

# merge them together
stock_data_long %<>% full_join(sp_500_data)
## Joining, by = c("ticker", "year", "price", "type")
# Use the 'dplyr' package to group the data by ticker and calculate the percent change from one year to the next
library(dplyr)

stock_data_long <- stock_data_long %>% 
  group_by(ticker) %>% 
  mutate(price_change_from_prev_year = (price - lag(price))/lag(price))

stock_data_long
## # A tibble: 4,338 × 5
## # Groups:   ticker [202]
##    ticker    year  price type                    price_change_from_prev_year
##    <chr>     <chr> <dbl> <chr>                                         <dbl>
##  1 005930.KS 2000   6000 ACSI Surveyed Companies                    NA      
##  2 005930.KS 2001   3160 ACSI Surveyed Companies                    -0.473  
##  3 005930.KS 2002   5580 ACSI Surveyed Companies                     0.766  
##  4 005930.KS 2003   6280 ACSI Surveyed Companies                     0.125  
##  5 005930.KS 2004   9020 ACSI Surveyed Companies                     0.436  
##  6 005930.KS 2005   9050 ACSI Surveyed Companies                     0.00333
##  7 005930.KS 2006  13280 ACSI Surveyed Companies                     0.467  
##  8 005930.KS 2007  12400 ACSI Surveyed Companies                    -0.0663 
##  9 005930.KS 2008  11180 ACSI Surveyed Companies                    -0.0984 
## 10 005930.KS 2009   9070 ACSI Surveyed Companies                    -0.189  
## # … with 4,328 more rows

How many tickers do we have in total now? Not all tickers in the dataset are still available (some are now defunct).

stock_data_long %>% pull(ticker) %>% unique() %>% length()
## [1] 202
# Calculate the median price change from previous year for each year
median_changes <- stock_data_long %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
## Warning: Removed 2 rows containing missing values (`geom_col()`).

How many years were median ACSI surveyed company returns higher than the S&P500?

count_highest_types <- function(median_changes) {
  # Convert factor type column to character if needed
  if (is.factor(median_changes$type)) {
    median_changes$type <- as.character(median_changes$type)
  }
  
  highest_types <- c()
  for (x in median_changes$year %>% unique()) {
    yearly_data <- median_changes %>% filter(year == x)
    # Find the type with the highest median_change value
    highest_types <- c(highest_types, yearly_data$type[which.max(yearly_data$median_change)])
  }
  # Count the occurrences of each element in an array
  counts <- table(highest_types)
  
  # Return the counts
  return(counts)
}

count_highest_types(median_changes)
## highest_types
## ACSI Surveyed Companies                 S&P 500 
##                      13                      13

Pretty equivalent…

Now lets compare cumulative performance of ACSI companies and S&P 500

plot_cumulative_performance <- function(df) {
  
  starting_amount <- 100000
  # Calculate cumulative performance for each trading strategy
  df_cumulative <- df %>%
    group_by(type) %>%
    arrange(year) %>%
    mutate(cumulative_return = cumprod(1 + median_change) * starting_amount)
  
  # Loop through all possible types in df_cumulative and print the final cumulative return
  for (t in unique(df_cumulative$type)) {
    #get the standard deviation in returns
    annual_mean_return <- df %>% filter(type == t) %>% drop_na() %>% pull(median_change) %>% mean()
    annual_sd_return <- df %>% filter(type == t) %>% drop_na() %>% pull(median_change) %>% sd()
    print(paste0(t, ": ", annual_mean_return, "+/-", annual_sd_return))

    final_return <- df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return)
    cat(paste0(t, ": ", round(final_return, 2), "\n"))
    final_return <- (df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return) / starting_amount - 1) * 100
    cat(paste0(t, ": ", round(final_return, 2), "%\n"))
  }
  
  # Plot cumulative performance for each trading strategy
  ggplot(df_cumulative, aes(x = year, y = cumulative_return, color = type, group=type)) +
    geom_line(size = 1) +
    scale_y_continuous(labels = scales::dollar, limits=c(0,3000000)) +
    labs(x = "Year", y = "Portfolio Balance", title = "Cumulative Performance") +
    theme_classic() +
    guides(color=guide_legend(title="Group")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    theme(legend.position = "right", legend.title=element_blank()) +
    theme(plot.title = element_text(face="bold")) +
    xlab("")
  
}

acsi_total_data <- median_changes %>% drop_na()

plot_cumulative_performance(median_changes %>% drop_na())
## [1] "ACSI Surveyed Companies: 0.0972256498177776+/-0.151010517168814"
## ACSI Surveyed Companies: 860506.02
## ACSI Surveyed Companies: 760.51%
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.

Compare the mean and standard deviation of median returns by year?

S&P 500

median_changes %>% filter(type == "S&P 500") %>% drop_na() %>% pull(median_change) %>% mean()
## [1] 0.1002879
median_changes %>% filter(type == "S&P 500") %>% drop_na() %>% pull(median_change) %>% sd()
## [1] 0.1782026

ACSI Surveyed Companies

median_changes %>% filter(type == "ACSI Surveyed Companies") %>% drop_na() %>% pull(median_change) %>% mean()
## [1] 0.09722565
median_changes %>% filter(type == "ACSI Surveyed Companies") %>% drop_na() %>% pull(median_change) %>% sd()
## [1] 0.1510105

The S&P 500 has a 10.0% mean return with a 17.8% SD over the time period available while ACSI Surveyed Companies had a 9.7% mean return.

Overall, it looks like the companies that were surveyed for inclusion in the ACSI had a cumulative higher performance than the S&P 500 despite having lower mean returns. But this can be skewed by a few good years (or reduced downturns, not overall more robust performance),

Analysis

Does picking the top 5/10/25% of companies by consumer satisfaction score each year beat the bottom 5/10/25%?

We need to label each row for each year as belonging to the top or bottom cutoff portion

label_data <- function(df, top_cutoff, bottom_cutoff) {
  library(dplyr)
  
  df_labeled <- df %>% 
    group_by(year) %>% 
    mutate(top_score = quantile(score, 1 - top_cutoff),
           bottom_score = quantile(score, bottom_cutoff),
           label = case_when(score >= top_score ~ "top",
                             score <= bottom_score ~ "bottom",
                             TRUE ~ "none")) %>% 
    ungroup()
  
  return(df_labeled)
}

Top and Bottom 5%

Get the labels for each row, for each year

We add one to each year, since we will be looking at the price for the next year after the score comes out. We want to take the median return for each strategy over that time period.

labeled_data <- label_data(score_data_long %>% drop_na(), 0.05, 0.05)

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 
stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top 5% Companies (ACSI Score)"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Mid 90% Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom 5% Companies (ACSI Score)"

Merge them together

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data)# %>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
# why is it short, shouldn't it contain almost all the data? 
compiled_data
## # A tibble: 241 × 6
## # Groups:   ticker [41]
##    ticker year  price type    price_change_from_prev_year ticker_year
##    <chr>  <chr> <dbl> <chr>                         <dbl> <chr>      
##  1 SPY    1995   45.7 S&P 500                      NA     SPY_1995   
##  2 SPY    1996   61.4 S&P 500                       0.344 SPY_1996   
##  3 SPY    1997   74.4 S&P 500                       0.211 SPY_1997   
##  4 SPY    1998   97.3 S&P 500                       0.308 SPY_1998   
##  5 SPY    1999  123.  S&P 500                       0.268 SPY_1999   
##  6 SPY    2000  148.  S&P 500                       0.202 SPY_2000   
##  7 SPY    2001  132   S&P 500                      -0.110 SPY_2001   
##  8 SPY    2002  115.  S&P 500                      -0.128 SPY_2002   
##  9 SPY    2003   88.8 S&P 500                      -0.228 SPY_2003   
## 10 SPY    2004  112.  S&P 500                       0.258 SPY_2004   
## # … with 231 more rows
median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 5% Companies (ACSI Score)", "Mid 90% Companies (ACSI Score)", "Bottom 5% Companies (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank())
## Warning: Removed 1 rows containing missing values (`geom_col()`).

View cumulative performance

p5_data <- median_changes %>% drop_na()

p5 <- plot_cumulative_performance(median_changes %>% drop_na())
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top 5% Companies (ACSI Score): 0.100672606229892+/-0.162447844477771"
## Top 5% Companies (ACSI Score): 898167.54
## Top 5% Companies (ACSI Score): 798.17%
p5

How many times was each strategy the highest performing?

count_highest_types(median_changes)
## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                            14                            12

What about looking at specific years? This will be analyzed later to see if performance is declining in recent years…

count_highest_types(median_changes %>% filter(year %in% c("1997", "1998", "1999", "2000", "2001")))
## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                             3                             2
count_highest_types(median_changes %>% filter(year %in% c("2002", "2003", "2004", "2005", "2006")))
## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                             1                             4
count_highest_types(median_changes %>% filter(year %in% c("2007", "2008", "2009", "2010", "2011")))
## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                             1                             4
count_highest_types(median_changes %>% filter(year %in% c("2012", "2013", "2014", "2015", "2016")))
## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                             4                             1
count_highest_types(median_changes %>% filter(year %in% c("2017", "2018", "2019", "2020", "2021")))
## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                             4                             1

Top and Bottom 10%

# Re-run logic from top and bottom 5% with altered parameters/labels....
labeled_data <- label_data(score_data_long %>% drop_na(), 0.1, 0.1)

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top 10% Companies (ACSI Score)"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Mid 80% Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom 10% Companies (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 10% Companies (ACSI Score)", "Mid 80% Companies (ACSI Score)", "Bottom 10% Companies (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")
## Warning: Removed 1 rows containing missing values (`geom_col()`).

p10_data <- median_changes %>% drop_na()

p10 <- plot_cumulative_performance(median_changes %>% drop_na())
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top 10% Companies (ACSI Score): 0.0751997137007673+/-0.169191738808098"
## Top 10% Companies (ACSI Score): 481790.32
## Top 10% Companies (ACSI Score): 381.79%
p10

How many times was each strategy the highest performing?

count_highest_types(median_changes)
## highest_types
##                        S&P 500 Top 10% Companies (ACSI Score) 
##                             16                             10

Looking at compative performance by 5 year periods….

count_highest_types(median_changes %>% filter(year %in% c("1997", "1998", "1999", "2000", "2001")))
## highest_types
##                        S&P 500 Top 10% Companies (ACSI Score) 
##                              3                              2
count_highest_types(median_changes %>% filter(year %in% c("2002", "2003", "2004", "2005", "2006")))
## highest_types
##                        S&P 500 Top 10% Companies (ACSI Score) 
##                              1                              4
count_highest_types(median_changes %>% filter(year %in% c("2007", "2008", "2009", "2010", "2011")))
## highest_types
##                        S&P 500 Top 10% Companies (ACSI Score) 
##                              2                              3
count_highest_types(median_changes %>% filter(year %in% c("2012", "2013", "2014", "2015", "2016")))
## highest_types
##                        S&P 500 Top 10% Companies (ACSI Score) 
##                              4                              1
count_highest_types(median_changes %>% filter(year %in% c("2017", "2018", "2019", "2020", "2021")))
## highest_types
## S&P 500 
##       5

Top and Bottom 25%

# Re-run logic from top and bottom 5% with altered parameters/labels....
labeled_data <- label_data(score_data_long %>% drop_na(), 0.25, 0.25)

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top 25% Companies (ACSI Score)"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Mid 50% Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom 25% Companies (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 25% Companies (ACSI Score)", "Mid 50% Companies (ACSI Score)", "Bottom 25% Companies (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")
## Warning: Removed 1 rows containing missing values (`geom_col()`).

p25_data <- median_changes %>% drop_na()

p25 <- plot_cumulative_performance(median_changes %>% drop_na())
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top 25% Companies (ACSI Score): 0.0805406108563645+/-0.157748573704633"
## Top 25% Companies (ACSI Score): 567965.88
## Top 25% Companies (ACSI Score): 467.97%
p25

How many times was each strategy the highest performing?

count_highest_types(median_changes)
## highest_types
##                        S&P 500 Top 25% Companies (ACSI Score) 
##                             14                             12

Looking at compative performance by 5 year periods….

count_highest_types(median_changes %>% filter(year %in% c("1997", "1998", "1999", "2000", "2001")))
## highest_types
##                        S&P 500 Top 25% Companies (ACSI Score) 
##                              3                              2
count_highest_types(median_changes %>% filter(year %in% c("2002", "2003", "2004", "2005", "2006")))
## highest_types
##                        S&P 500 Top 25% Companies (ACSI Score) 
##                              2                              3
count_highest_types(median_changes %>% filter(year %in% c("2007", "2008", "2009", "2010", "2011")))
## highest_types
## Top 25% Companies (ACSI Score) 
##                              5
count_highest_types(median_changes %>% filter(year %in% c("2012", "2013", "2014", "2015", "2016")))
## highest_types
##                        S&P 500 Top 25% Companies (ACSI Score) 
##                              3                              2
count_highest_types(median_changes %>% filter(year %in% c("2017", "2018", "2019", "2020", "2021")))
## highest_types
## S&P 500 
##       5

Top and Bottom 1%

# Re-run logic from top and bottom 5% with altered parameters/labels....
labeled_data <- label_data(score_data_long %>% drop_na(), 0.01, 0.01)

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top 1% Companies (ACSI Score)"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Mid 98% Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom 1% Companies (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 1% Companies (ACSI Score)", "Mid 98% Companies (ACSI Score)", "Bottom 1% Companies (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")
## Warning: Removed 1 rows containing missing values (`geom_col()`).

p1_data <- median_changes %>% drop_na()

p1 <- plot_cumulative_performance(median_changes %>% drop_na())
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top 1% Companies (ACSI Score): 0.208808022053884+/-0.399131588164006"
## Top 1% Companies (ACSI Score): 3707407.25
## Top 1% Companies (ACSI Score): 3607.41%
p1
## Warning: Removed 1 row containing missing values (`geom_line()`).

Huh, how about that…I decided to just try running 1% after 5/10/25% for fun, and didn’t expect to see anything - but this result actually is the most pronounced of any. Looking at the change by year, it looks like there was extraordinary performance in 2004 (more than doubling of stock price).

How many times was each strategy the highest performing?

count_highest_types(median_changes)
## highest_types
##                       S&P 500 Top 1% Companies (ACSI Score) 
##                            13                            13

Looking at compative performance by 5 year periods….

count_highest_types(median_changes %>% filter(year %in% c("1997", "1998", "1999", "2000", "2001")))
## highest_types
##                       S&P 500 Top 1% Companies (ACSI Score) 
##                             3                             2
count_highest_types(median_changes %>% filter(year %in% c("2002", "2003", "2004", "2005", "2006")))
## highest_types
## Top 1% Companies (ACSI Score) 
##                             5
count_highest_types(median_changes %>% filter(year %in% c("2007", "2008", "2009", "2010", "2011")))
## highest_types
##                       S&P 500 Top 1% Companies (ACSI Score) 
##                             2                             3
count_highest_types(median_changes %>% filter(year %in% c("2012", "2013", "2014", "2015", "2016")))
## highest_types
##                       S&P 500 Top 1% Companies (ACSI Score) 
##                             3                             2
count_highest_types(median_changes %>% filter(year %in% c("2017", "2018", "2019", "2020", "2021")))
## highest_types
##                       S&P 500 Top 1% Companies (ACSI Score) 
##                             4                             1

What company(s) is driving this?

top_stock_data %>% filter(year == 2004)
## # A tibble: 1 × 5
## # Groups:   ticker [1]
##   ticker year  price type                          price_change_from_prev_year
##   <chr>  <chr> <dbl> <chr>                                               <dbl>
## 1 AMZN   2004   2.64 Top 1% Companies (ACSI Score)                        1.75

Amazon!

What companies are in the top companies and bottom companies?

#top companies
score_data %>% filter(ticker %in% c(top_stock_data %>% pull(ticker) %>% unique())) 
## # A tibble: 36 × 31
##     ...1 compa…¹ sector publi…² ticker `1995` `1996` `1997` `1998` `1999` `2000`
##    <dbl> <chr>   <chr>  <chr>   <chr>  <chr>  <chr>  <chr>  <chr>  <chr>  <chr> 
##  1     0 FedEx   Consu… Yes     FDX    85     86     82     80     83     83    
##  2    47 Unilev… Perso… Yes     UL     83     83     82     83     81     85    
##  3    96 Texas … Full-… Yes     TXRH                        <NA>   <NA>   <NA>  
##  4   103 BMW     Autom… Yes     BMWYY  81     81     80     86     86     84    
##  5   104 Cadill… Autom… Yes     GM     84     88     84     88     85     86    
##  6   105 Chevro… Autom… Yes     GM     79     79     78     79     76     80    
##  7   108 Ford    Autom… Yes     F      79     78     77     77     77     77    
##  8   109 GMC (G… Autom… Yes     GM     <NA>   <NA>   80     78     81     81    
##  9   110 Honda   Autom… Yes     HMC    86     83     82     81     83     82    
## 10   131 Buick … Autom… Yes     GM     84     84     83     84     86     86    
## # … with 26 more rows, 20 more variables: `2001` <chr>, `2002` <chr>,
## #   `2003` <chr>, `2004` <chr>, `2005` <chr>, `2006` <chr>, `2007` <chr>,
## #   `2008` <chr>, `2009` <chr>, `2010` <chr>, `2011` <chr>, `2012` <chr>,
## #   `2013` <chr>, `2014` <chr>, `2015` <chr>, `2016` <chr>, `2017` <chr>,
## #   `2018` <chr>, `2019` <chr>, `2020` <chr>, and abbreviated variable names
## #   ¹​company_name, ²​publicly_traded
# bottom companies
score_data %>% filter(ticker %in% c(bottom_stock_data %>% pull(ticker) %>% unique()))
## # A tibble: 23 × 31
##     ...1 compa…¹ sector publi…² ticker `1995` `1996` `1997` `1998` `1999` `2000`
##    <dbl> <chr>   <chr>  <chr>   <chr>  <chr>  <chr>  <chr>  <chr>  <chr>  <chr> 
##  1    29 Everso… Inves… Yes     ES     70     72     67     65     68     72    
##  2    31 PG&E    Inves… Yes     PCG    71     72     71     68     71     73    
##  3    48 Optimu… Inter… Yes     ATUS                                            
##  4    50 Optimu… Fixed… Yes     ATUS   <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  5    55 Spirit  Airli… Yes     SAVE   <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  6    69 Sudden… Subsc… Yes     ATUS                        <NA>   <NA>   <NA>  
##  7   163 Xfinit… Video… Yes     CMCSA  <NA>   <NA>                              
##  8   164 Spectr… Video… Yes     CHTR   <NA>   <NA>                              
##  9   169 Micros… Video… Yes     MSFT   <NA>   <NA>                              
## 10   182 Merril… Finan… Yes     BAC                                             
## # … with 13 more rows, 20 more variables: `2001` <chr>, `2002` <chr>,
## #   `2003` <chr>, `2004` <chr>, `2005` <chr>, `2006` <chr>, `2007` <chr>,
## #   `2008` <chr>, `2009` <chr>, `2010` <chr>, `2011` <chr>, `2012` <chr>,
## #   `2013` <chr>, `2014` <chr>, `2015` <chr>, `2016` <chr>, `2017` <chr>,
## #   `2018` <chr>, `2019` <chr>, `2020` <chr>, and abbreviated variable names
## #   ¹​company_name, ²​publicly_traded

Create composite plot

grid.arrange(p1 +
  theme(legend.position = "none") + ggtitle("99th Percentile") + ylab(""), 
  p5 +
  theme(legend.position = "none") + ggtitle("95th Percentile") + ylab(""), 
  p10 +
  theme(legend.position = "none") + ggtitle("90th Percentile") + ylab(""), 
  p25 +
  theme(legend.position = "none") + ggtitle("75th Percentile") + ylab("")) 
## Warning: Removed 1 row containing missing values (`geom_line()`).

What does the curve look like for % picked and cumulative returns?

#function to extract cumulative performance each time
get_cumulative_performance <- function(df) {
  
  starting_amount <- 100000
  # Calculate cumulative performance for each trading strategy
  df_cumulative <- df %>%
    group_by(type) %>%
    arrange(year) %>%
    mutate(cumulative_return = cumprod(1 + median_change) * starting_amount)
  
  # Loop through all possible types in df_cumulative and print the final cumulative return
  for (t in unique(df_cumulative$type)) {
    final_return <- df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return)
    cat(paste0(t, ": ", round(final_return, 2), "\n"))
    final_return <- (df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return) / starting_amount - 1) * 100
    cat(paste0(t, ": ", round(final_return, 2), "%\n"))
  }
  
  final_return

}

return_results <- c()

for (input_percentile in seq(from = 0.01, to = 0.99, by = 0.01)) {
  
  labeled_data <- label_data(score_data_long %>% drop_na(), input_percentile, 0.01)
  
  top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 
  
  bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 
  
  mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 
  
  stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))
  
  top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
  top_stock_data$type <- "Top 1% Companies (ACSI Score)"
  
  mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
  mid_stock_data$type <- "Mid 98% Companies (ACSI Score)"
  
  bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
  bottom_stock_data$type <- "Bottom 1% Companies (ACSI Score)"
  
  compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)
  
  # If you want to look across specific years
  #compiled_data %<>% filter(year %in% c("2017", "2018", "2019", "2020", "2021"))
  #compiled_data %<>% filter(year %in% c("2012", "2013", "2014", "2015", "2016"))
  #compiled_data %<>% filter(year %in% c("2007", "2008", "2009", "2010", "2011"))
  #compiled_data %<>% filter(year %in% c("2002", "2003", "2004", "2005", "2006"))
  #compiled_data %<>% filter(year %in% c("1997", "1998", "1999", "2000", "2001"))
  
  median_changes <- compiled_data %>%
    group_by(year, type) %>%
    summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
  
  median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 1% Companies (ACSI Score)", "Mid 98% Companies (ACSI Score)", "Bottom 1% Companies (ACSI Score)"))
  
  
  
  
  
  return_results <- c(return_results, get_cumulative_performance(median_changes %>% drop_na()))
}
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 3707407.25
## Top 1% Companies (ACSI Score): 3607.41%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 2867702.56
## Top 1% Companies (ACSI Score): 2767.7%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 1548038.6
## Top 1% Companies (ACSI Score): 1448.04%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 1096353.36
## Top 1% Companies (ACSI Score): 996.35%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 898167.54
## Top 1% Companies (ACSI Score): 798.17%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 884141.14
## Top 1% Companies (ACSI Score): 784.14%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 819815.59
## Top 1% Companies (ACSI Score): 719.82%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 579228.13
## Top 1% Companies (ACSI Score): 479.23%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 541040.52
## Top 1% Companies (ACSI Score): 441.04%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 481790.32
## Top 1% Companies (ACSI Score): 381.79%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 544378.51
## Top 1% Companies (ACSI Score): 444.38%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 887033.49
## Top 1% Companies (ACSI Score): 787.03%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 684862.53
## Top 1% Companies (ACSI Score): 584.86%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 677350.21
## Top 1% Companies (ACSI Score): 577.35%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 767588.28
## Top 1% Companies (ACSI Score): 667.59%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 750783
## Top 1% Companies (ACSI Score): 650.78%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 775814.65
## Top 1% Companies (ACSI Score): 675.81%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 832465.77
## Top 1% Companies (ACSI Score): 732.47%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 814269.04
## Top 1% Companies (ACSI Score): 714.27%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 537295.22
## Top 1% Companies (ACSI Score): 437.3%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 558472.24
## Top 1% Companies (ACSI Score): 458.47%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 520396.56
## Top 1% Companies (ACSI Score): 420.4%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 526481.04
## Top 1% Companies (ACSI Score): 426.48%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 553426.22
## Top 1% Companies (ACSI Score): 453.43%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 567965.88
## Top 1% Companies (ACSI Score): 467.97%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 569096.3
## Top 1% Companies (ACSI Score): 469.1%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 592232.38
## Top 1% Companies (ACSI Score): 492.23%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 481934.41
## Top 1% Companies (ACSI Score): 381.93%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 472332.54
## Top 1% Companies (ACSI Score): 372.33%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 466116.54
## Top 1% Companies (ACSI Score): 366.12%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 472646.45
## Top 1% Companies (ACSI Score): 372.65%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 479159.41
## Top 1% Companies (ACSI Score): 379.16%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 488555.57
## Top 1% Companies (ACSI Score): 388.56%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 488441.11
## Top 1% Companies (ACSI Score): 388.44%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 490404.23
## Top 1% Companies (ACSI Score): 390.4%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 508667.01
## Top 1% Companies (ACSI Score): 408.67%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 502168.43
## Top 1% Companies (ACSI Score): 402.17%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 499674.96
## Top 1% Companies (ACSI Score): 399.67%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 534043.8
## Top 1% Companies (ACSI Score): 434.04%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 522850.2
## Top 1% Companies (ACSI Score): 422.85%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 522850.2
## Top 1% Companies (ACSI Score): 422.85%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 513625.57
## Top 1% Companies (ACSI Score): 413.63%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 515114.54
## Top 1% Companies (ACSI Score): 415.11%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 533191.71
## Top 1% Companies (ACSI Score): 433.19%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 534881.51
## Top 1% Companies (ACSI Score): 434.88%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 529972.16
## Top 1% Companies (ACSI Score): 429.97%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 541581.03
## Top 1% Companies (ACSI Score): 441.58%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 591371.84
## Top 1% Companies (ACSI Score): 491.37%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 565968.59
## Top 1% Companies (ACSI Score): 465.97%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 560136.01
## Top 1% Companies (ACSI Score): 460.14%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 580476.92
## Top 1% Companies (ACSI Score): 480.48%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 597699.01
## Top 1% Companies (ACSI Score): 497.7%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 608023.58
## Top 1% Companies (ACSI Score): 508.02%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 608165.14
## Top 1% Companies (ACSI Score): 508.17%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 625140.71
## Top 1% Companies (ACSI Score): 525.14%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 615155.54
## Top 1% Companies (ACSI Score): 515.16%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 591033.65
## Top 1% Companies (ACSI Score): 491.03%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 585537.23
## Top 1% Companies (ACSI Score): 485.54%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 600817.67
## Top 1% Companies (ACSI Score): 500.82%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 573744.13
## Top 1% Companies (ACSI Score): 473.74%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 564923.45
## Top 1% Companies (ACSI Score): 464.92%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 592579.57
## Top 1% Companies (ACSI Score): 492.58%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 566164.74
## Top 1% Companies (ACSI Score): 466.16%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 570769.65
## Top 1% Companies (ACSI Score): 470.77%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 571609.38
## Top 1% Companies (ACSI Score): 471.61%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 566136.87
## Top 1% Companies (ACSI Score): 466.14%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 571665.22
## Top 1% Companies (ACSI Score): 471.67%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 576305.74
## Top 1% Companies (ACSI Score): 476.31%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 570148.88
## Top 1% Companies (ACSI Score): 470.15%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 569631.9
## Top 1% Companies (ACSI Score): 469.63%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 547261.26
## Top 1% Companies (ACSI Score): 447.26%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 548209.94
## Top 1% Companies (ACSI Score): 448.21%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 554631.63
## Top 1% Companies (ACSI Score): 454.63%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 554979.33
## Top 1% Companies (ACSI Score): 454.98%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 555455.73
## Top 1% Companies (ACSI Score): 455.46%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 547210.13
## Top 1% Companies (ACSI Score): 447.21%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 548549.28
## Top 1% Companies (ACSI Score): 448.55%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 555858.55
## Top 1% Companies (ACSI Score): 455.86%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 540619.6
## Top 1% Companies (ACSI Score): 440.62%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 532801.5
## Top 1% Companies (ACSI Score): 432.8%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 538707.46
## Top 1% Companies (ACSI Score): 438.71%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 533476.01
## Top 1% Companies (ACSI Score): 433.48%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 551239.89
## Top 1% Companies (ACSI Score): 451.24%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 561596.57
## Top 1% Companies (ACSI Score): 461.6%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 564088.6
## Top 1% Companies (ACSI Score): 464.09%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 563708.36
## Top 1% Companies (ACSI Score): 463.71%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 565112.38
## Top 1% Companies (ACSI Score): 465.11%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 554779.46
## Top 1% Companies (ACSI Score): 454.78%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 551784.06
## Top 1% Companies (ACSI Score): 451.78%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 567533.68
## Top 1% Companies (ACSI Score): 467.53%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 566263.94
## Top 1% Companies (ACSI Score): 466.26%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 574906.99
## Top 1% Companies (ACSI Score): 474.91%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 570026.43
## Top 1% Companies (ACSI Score): 470.03%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 569263.53
## Top 1% Companies (ACSI Score): 469.26%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 575759.02
## Top 1% Companies (ACSI Score): 475.76%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 565327.63
## Top 1% Companies (ACSI Score): 465.33%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 562019.18
## Top 1% Companies (ACSI Score): 462.02%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 551600.52
## Top 1% Companies (ACSI Score): 451.6%
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 553104.12
## Top 1% Companies (ACSI Score): 453.1%
return_results
##  [1] 3607.4073 2767.7026 1448.0386  996.3534  798.1675  784.1411  719.8156
##  [8]  479.2281  441.0405  381.7903  444.3785  787.0335  584.8625  577.3502
## [15]  667.5883  650.7830  675.8146  732.4658  714.2690  437.2952  458.4722
## [22]  420.3966  426.4810  453.4262  467.9659  469.0963  492.2324  381.9344
## [29]  372.3325  366.1165  372.6465  379.1594  388.5556  388.4411  390.4042
## [36]  408.6670  402.1684  399.6750  434.0438  422.8502  422.8502  413.6256
## [43]  415.1145  433.1917  434.8815  429.9722  441.5810  491.3718  465.9686
## [50]  460.1360  480.4769  497.6990  508.0236  508.1651  525.1407  515.1555
## [57]  491.0336  485.5372  500.8177  473.7441  464.9235  492.5796  466.1647
## [64]  470.7696  471.6094  466.1369  471.6652  476.3057  470.1489  469.6319
## [71]  447.2613  448.2099  454.6316  454.9793  455.4557  447.2101  448.5493
## [78]  455.8586  440.6196  432.8015  438.7075  433.4760  451.2399  461.5966
## [85]  464.0886  463.7084  465.1124  454.7795  451.7841  467.5337  466.2639
## [92]  474.9070  470.0264  469.2635  475.7590  465.3276  462.0192  451.6005
## [99]  453.1041

Plot the two

# Generate example data
x <- rev(seq(from = 0.01, to = 0.99, by = 0.01))
y <- return_results

# Combine x and y into a data frame
data <- data.frame(x, y)

# Create plot object
ggplot(data, aes(x=x, y=y)) + 

  # Add line layer
  geom_line(color="#1cb4b6") +
  
  # Add x and y axis labels
  xlab("ACSI Percentile") + ylab("Returns (%)") +
  
  # Add plot title
  ggtitle("") + theme_bw() + geom_hline(yintercept=114.96,linetype=2, color = "#f55c54") +
  geom_area(aes(fill=y), alpha = 0.2) + theme_classic() +
  theme(legend.position = "none") 

Does picking the top company in each sector in terms of consumer satisfaction beat the S&P 500?

# take the top one in each sector, needs to be slightly modified
label_data_sector <- function(df, top_cutoff, bottom_cutoff) {

  rows <- 2 # we want to filter out sectors with less than 2 companies in that year 
  
  df_labeled <- df %>% 
    group_by(year, sector) %>% 
    mutate(top_score = quantile(score, 1 - top_cutoff),
           bottom_score = quantile(score, bottom_cutoff),
           label = case_when(score >= top_score ~ "top",
                             score <= bottom_score ~ "bottom",
                             TRUE ~ "none")) %>% filter(n() >= rows) %>% 
    ungroup()
  
  return(df_labeled)
}
labeled_data <- label_data_sector(score_data_long %>% drop_na(), 0.01, 0.01) #take the companies in the 99th and 1st Percentiles

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top Company in Each Sector"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Other Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom Companies in Each Sector (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top Company in Each Sector", "Other Companies (ACSI Score)", "Bottom Companies in Each Sector (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")
## Warning: Removed 1 rows containing missing values (`geom_col()`).

ps_data <- median_changes %>% drop_na()

plot_cumulative_performance(median_changes %>% drop_na()) + xlab("")
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top Company in Each Sector: 0.114663112249387+/-0.148336429241189"
## Top Company in Each Sector: 1317441.4
## Top Company in Each Sector: 1217.44%

How many times was each strategy the highest performing?

count_highest_types(median_changes)
## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          9                         17
count_highest_types(median_changes %>% filter(year %in% c("1997", "1998", "1999", "2000", "2001")))
## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          2                          3
count_highest_types(median_changes %>% filter(year %in% c("2002", "2003", "2004", "2005", "2006")))
## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          1                          4
count_highest_types(median_changes %>% filter(year %in% c("2007", "2008", "2009", "2010", "2011")))
## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          1                          4
count_highest_types(median_changes %>% filter(year %in% c("2012", "2013", "2014", "2015", "2016")))
## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          1                          4
count_highest_types(median_changes %>% filter(year %in% c("2017", "2018", "2019", "2020", "2021")))
## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          3                          2

Picking the top company in each sector seems to do better than S&P500 and other strategies.

Does the trend break down after a certain year? After the results were published?

Top 1%

# Re-run logic from top and bottom 5% with altered parameters/labels....
labeled_data <- label_data(score_data_long %>% drop_na(), 0.01, 0.01)

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top 1% Companies (ACSI Score)"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Mid 98% Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom 1% Companies (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
# Only look in recent years
#compiled_data %<>% filter(year %in% c("2014", "2015", "2016", "2017", "2018", "2019", "2020"))

median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 1% Companies (ACSI Score)", "Mid 98% Companies (ACSI Score)", "Bottom 1% Companies (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")
## Warning: Removed 1 rows containing missing values (`geom_col()`).

p1 <- plot_cumulative_performance(median_changes %>% drop_na())
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top 1% Companies (ACSI Score): 0.208808022053884+/-0.399131588164006"
## Top 1% Companies (ACSI Score): 3707407.25
## Top 1% Companies (ACSI Score): 3607.41%
p1
## Warning: Removed 1 row containing missing values (`geom_line()`).

top_1_percentile_data <- median_changes
ggplot(median_changes, aes(x = year, y = median_change, color = type, group=type)) +
    geom_line(size = 1) +
    labs(x = "Year", y = "Change", title = "Cumulative Performance") +
    theme_classic() +
    guides(color=guide_legend(title="Group")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    theme(legend.position = "right", legend.title=element_blank()) +
    theme(plot.title = element_text(face="bold")) +
    xlab("") + geom_hline(yintercept=0,linetype=2, color = "grey")
## Warning: Removed 1 row containing missing values (`geom_line()`).

Top Company in Each Sector

labeled_data <- label_data_sector(score_data_long %>% drop_na(), 0.01, 0.01) #take the companies in the 99th and 1st Percentiles


top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top Company in Each Sector"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Other Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom Companies in Each Sector (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
# Only look in recent years
#compiled_data %<>% filter(year %in% c("2014", "2015", "2016", "2017", "2018", "2019", "2020"))

median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top Company in Each Sector", "Other Companies (ACSI Score)", "Bottom Companies in Each Sector (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")
## Warning: Removed 1 rows containing missing values (`geom_col()`).

plot_cumulative_performance(median_changes %>% drop_na()) + xlab("")
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top Company in Each Sector: 0.114663112249387+/-0.148336429241189"
## Top Company in Each Sector: 1317441.4
## Top Company in Each Sector: 1217.44%

Plot the performance per year

ggplot(median_changes, aes(x = year, y = median_change, color = type, group=type)) +
    geom_line(size = 1) +
    labs(x = "Year", y = "Change", title = "Cumulative Performance") +
    theme_classic() +
    guides(color=guide_legend(title="Group")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    theme(legend.position = "right", legend.title=element_blank()) +
    theme(plot.title = element_text(face="bold")) +
    xlab("") + geom_hline(yintercept=0,linetype=2, color = "grey")
## Warning: Removed 1 row containing missing values (`geom_line()`).

Compare top company in each sector and top 1%

top_1_percentile_data %<>% filter(type != "S&P 500")
ggplot(median_changes %>% full_join(top_1_percentile_data), aes(x = year, y = median_change, color = type, group=type)) +
    geom_line(size = 1) +
    labs(x = "Year", y = "Change", title = "Annual Returns") +
    theme_classic() +
    guides(color=guide_legend(title="Group")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    theme(legend.position = "right", legend.title=element_blank()) +
    theme(plot.title = element_text(face="bold")) +
    xlab("") + geom_hline(yintercept=0,linetype=2, color = "grey")
## Joining, by = c("year", "type", "median_change")
## Warning: Removed 1 row containing missing values (`geom_line()`).

Does picking sectors with the highest satisfaction beat the S&P 500?

This needs to be expanded, we need to add logic that picks the sector with the highest scores. This is slightly derivative and not that different though…

# create the first one
compiled_data <- stock_data_long %>% filter(ticker == "SPY")


# go through each sector
for (sector_type in score_data_long$sector %>% unique()) {
  sector_ticker_year_pairs <- score_data_long %>% filter(sector == sector_type) %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 
  select_stock_data <- stock_data_long %>% filter(ticker_year %in% sector_ticker_year_pairs) %>% select(-ticker_year)
select_stock_data$type <- sector_type

  

  # add it to the compiled data
  compiled_data %<>% full_join(select_stock_data)
  
}
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
sector_options <- c("S&P 500")
for (sector_name in score_data_long$sector %>% unique()) {
  sector_options <- c(sector_options, sector_name)
}
 
median_changes$type <- factor(median_changes$type, levels=sector_options)

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")
## Warning: Removed 7 rows containing missing values (`geom_col()`).

plot_cumulative_performance(median_changes %>% drop_na()) + xlab("")
## [1] "Airlines: 0.176687262136455+/-0.384515675069081"
## Airlines: 1656853.72
## Airlines: 1556.85%
## [1] "Apparel: 0.136751737906527+/-0.275032165754184"
## Apparel: 1167645.01
## Apparel: 1067.65%
## [1] "Athletic Shoes: 0.186755174111474+/-0.291068988375815"
## Athletic Shoes: 3369101.53
## Athletic Shoes: 3269.1%
## [1] "Automobiles and Light Vehicles: 0.0579756622901008+/-0.276870352427774"
## Automobiles and Light Vehicles: 189141.5
## Automobiles and Light Vehicles: 89.14%
## [1] "Banks: 0.105496148933519+/-0.221153974678497"
## Banks: 741862.55
## Banks: 641.86%
## [1] "Breweries: 0.136437956489888+/-0.281505010996068"
## Breweries: 1154508.91
## Breweries: 1054.51%
## [1] "Cellular Telephones: 0.267329122528215+/-1.0012549107222"
## Cellular Telephones: 1039851.85
## Cellular Telephones: 939.85%
## [1] "Computer Software: 0.231747073212364+/-0.398500986767627"
## Computer Software: 4130861.76
## Computer Software: 4030.86%
## [1] "Consumer Shipping: 0.121830587930321+/-0.214498474144428"
## Consumer Shipping: 1236643.9
## Consumer Shipping: 1136.64%
## [1] "Department and Discount Stores: 0.116734163408508+/-0.230649385388318"
## Department and Discount Stores: 920319.45
## Department and Discount Stores: 820.32%
## [1] "Financial Advisors: 0.115677429428235+/-0.27226345182076"
## Financial Advisors: 668067.57
## Financial Advisors: 568.07%
## [1] "Fixed-Line Telephone Service: 0.0680750197102281+/-0.223339239061943"
## Fixed-Line Telephone Service: 312220.69
## Fixed-Line Telephone Service: 212.22%
## [1] "Food Manufacturing: 0.0734286764151807+/-0.164889351938863"
## Food Manufacturing: 432929.82
## Food Manufacturing: 332.93%
## [1] "Full-Service Restaurants: 0.149887040196856+/-0.202385685587937"
## Full-Service Restaurants: 2223987.13
## Full-Service Restaurants: 2123.99%
## [1] "Gasoline Stations: 0.150252775767991+/-0.102480256052002"
## Gasoline Stations: 226886.66
## Gasoline Stations: 126.89%
## [1] "Health and Personal Care Stores: 0.136534115013567+/-0.267460323868653"
## Health and Personal Care Stores: 1249864.95
## Health and Personal Care Stores: 1149.86%
## [1] "Health Insurance: 0.184622800007245+/-0.244099749461849"
## Health Insurance: 4041769.98
## Health Insurance: 3941.77%
## [1] "Household Appliances: 0.137468362026771+/-0.399684501585797"
## Household Appliances: 554362.44
## Household Appliances: 454.36%
## [1] "Internet Investment Services: 0.207348054157065+/-0.398047093706746"
## Internet Investment Services: 2793326.27
## Internet Investment Services: 2693.33%
## [1] "Internet News and Opinion: 0.0618804720360484+/-0.292991028920415"
## Internet News and Opinion: 163809.43
## Internet News and Opinion: 63.81%
## [1] "Internet Retail: 0.225548711238225+/-0.436299274383031"
## Internet Retail: 2772734.79
## Internet Retail: 2672.73%
## [1] "Internet Service Providers: 0.194899431457417+/-0.350757677912917"
## Internet Service Providers: 2918580.54
## Internet Service Providers: 2818.58%
## [1] "Internet Social Media: 0.368285679270924+/-0.424870466375406"
## Internet Social Media: 14041285.15
## Internet Social Media: 13941.29%
## [1] "Investor-Owned Energy Utilities: 0.0746571011397432+/-0.151424274304235"
## Investor-Owned Energy Utilities: 499755.76
## Investor-Owned Energy Utilities: 399.76%
## [1] "Limited-Service Restaurants: 0.139248040308854+/-0.224435710661761"
## Limited-Service Restaurants: 1403059.77
## Limited-Service Restaurants: 1303.06%
## [1] "Motion Pictures: 0.210662898887278+/-NA"
## Motion Pictures: 121066.29
## Motion Pictures: 21.07%
## [1] "Network/Cable TV News: 0.285326058516712+/-NA"
## Network/Cable TV News: 128532.61
## Network/Cable TV News: 28.53%
## [1] "Newspapers: 0.335227272727273+/-NA"
## Newspapers: 133522.73
## Newspapers: 33.52%
## [1] "Personal Care and Cleaning Products: 0.103020559662606+/-0.147928153101665"
## Personal Care and Cleaning Products: 940638.1
## Personal Care and Cleaning Products: 840.64%
## [1] "Personal Computers: 0.24556934674859+/-0.46606725696862"
## Personal Computers: 4024618.15
## Personal Computers: 3924.62%
## [1] "Pet Food: 0.123394358531076+/-0.169259972443039"
## Pet Food: 1420572.16
## Pet Food: 1320.57%
## [1] "Property and Casualty Insurance: 0.137813879015737+/-0.299734916672751"
## Property and Casualty Insurance: 1081707.93
## Property and Casualty Insurance: 981.71%
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Soft Drinks: 0.086209240232677+/-0.160789963782022"
## Soft Drinks: 601618.49
## Soft Drinks: 501.62%
## [1] "Specialty Retail Stores: 0.1514599144648+/-0.326061086490932"
## Specialty Retail Stores: 1313169.39
## Specialty Retail Stores: 1213.17%
## [1] "Subscription Television: 0.0867734551897014+/-0.209771527749837"
## Subscription Television: 252342.11
## Subscription Television: 152.34%
## [1] "Subscription Television Service: 0.287465437453642+/-0.77791918763654"
## Subscription Television Service: 4221991.43
## Subscription Television Service: 4121.99%
## [1] "Supermarkets: 0.120187577528246+/-0.253167299132231"
## Supermarkets: 915594.39
## Supermarkets: 815.59%
## [1] "Televisions and Video Players: 0.249219508111845+/-0.0800664106961531"
## Televisions and Video Players: 155734.41
## Televisions and Video Players: 55.73%
## [1] "Wireless Telephone Service: 0.0635466403074176+/-0.24121337236302"
## Wireless Telephone Service: 252835.91
## Wireless Telephone Service: 152.84%
## [1] "Life Insurance: 0.109559525292321+/-0.292101190520864"
## Life Insurance: 576866.98
## Life Insurance: 476.87%
## [1] "Video Streaming Service: 0.518883844333666+/-1.20684217613686"
## Video Streaming Service: 24750756.72
## Video Streaming Service: 24650.76%
## [1] "Video-on-Demand Service: 0.147168069855939+/-0.314210573426174"
## Video-on-Demand Service: 1022882.69
## Video-on-Demand Service: 922.88%
## [1] "Hotels: 0.103071160911382+/-0.259202266792263"
## Hotels: 450061.31
## Hotels: 350.06%
## [1] "Internet Search Engines and Information: 0.30740390641944+/-0.452377556475301"
## Internet Search Engines and Information: 2694122.8
## Internet Search Engines and Information: 2594.12%
## [1] "Internet Travel Services: 0.199693159397023+/-0.706537401755926"
## Internet Travel Services: 162381.55
## Internet Travel Services: 62.38%
## [1] "Cigarettes: 0.122781261704128+/-0.177031115754438"
## Cigarettes: 169399.99
## Cigarettes: 69.4%
## [1] "Personal Computers and Household Appliances: 0.194311327111837+/-0.317141426059297"
## Personal Computers and Household Appliances: 207089.55
## Personal Computers and Household Appliances: 107.09%
## [1] "Personal Computers and Internet Retail: 0.466128520017841+/-0.382751890940777"
## Personal Computers and Internet Retail: 599846.45
## Personal Computers and Internet Retail: 499.85%
## [1] "Internet Service Providers/Fixed-Line Phone: 0.0457617887949242+/-0.570116117412604"
## Internet Service Providers/Fixed-Line Phone: 87310.13
## Internet Service Providers/Fixed-Line Phone: -12.69%
## Warning: Removed 24 rows containing missing values (`geom_line()`).

Create cumulative plot for all strategies

We need to make a slightly bigger one to handle the large (4M increase)

plot_cumulative_performance_modified <- function(df) {
  
  starting_amount <- 100000
  # Calculate cumulative performance for each trading strategy
  df_cumulative <- df %>%
    group_by(type) %>%
    arrange(year) %>%
    mutate(cumulative_return = cumprod(1 + median_change) * starting_amount)
  
  # Loop through all possible types in df_cumulative and print the final cumulative return
  for (t in unique(df_cumulative$type)) {
    #get the standard deviation in returns
    annual_mean_return <- df %>% filter(type == t) %>% drop_na() %>% pull(median_change) %>% mean()
    annual_sd_return <- df %>% filter(type == t) %>% drop_na() %>% pull(median_change) %>% sd()
    print(paste0(t, ": ", annual_mean_return, "+/-", annual_sd_return))

    final_return <- df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return)
    cat(paste0(t, ": ", round(final_return, 2), "\n"))
    final_return <- (df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return) / starting_amount - 1) * 100
    cat(paste0(t, ": ", round(final_return, 2), "%\n"))
  }
  
  # Plot cumulative performance for each trading strategy
  ggplot(df_cumulative, aes(x = year, y = cumulative_return, color = type, group=type)) +
    geom_line(size=1) +
    scale_y_continuous(labels = scales::dollar, limits=c(0,4000000)) +
    labs(x = "Year", y = "Portfolio Balance", title = "Cumulative Performance") +
    theme_classic() +
    guides(color=guide_legend(title="Group")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    theme(legend.position = "right", legend.title=element_blank()) +
    theme(plot.title = element_text(face="bold")) +
    xlab("")
  
}
all_strategy_data <- p1_data %>% full_join(p5_data) %>% full_join(p10_data) %>% full_join(p25_data) %>% full_join(ps_data) %>% full_join(acsi_total_data) %>% distinct()
## Joining, by = c("year", "type", "median_change")
## Joining, by = c("year", "type", "median_change")
## Joining, by = c("year", "type", "median_change")
## Joining, by = c("year", "type", "median_change")
## Joining, by = c("year", "type", "median_change")
all_strategy_data %<>% mutate(type = case_when(
  type == "S&P 500" ~ "S&P 500",
  type == "Top 1% Companies (ACSI Score)" ~ "99th Percentile Across All Sectors",
  type == "Top 5% Companies (ACSI Score)" ~ "95th Percentile Across All Sectors",
  type == "Top 10% Companies (ACSI Score)" ~ "10th Percentile Across All Sectors",
  type == "Top 25% Companies (ACSI Score)" ~ "75th Percentile Across All Sectors",
  type == "Top Company in Each Sector" ~ "Top Company in Each Sector",
  type == "ACSI Surveyed Companies" ~ "All Publicly Traded Companies w/ ACSI Data",
))

all_strategy_data %<>% drop_na()

all_strategy_data$type <- factor(all_strategy_data$type, levels=c("Top Company in Each Sector", "99th Percentile Across All Sectors", "95th Percentile Across All Sectors", "90th Percentile Across All Sectors", "75th Percentile Across All Sectors", "All Publicly Traded Companies w/ ACSI Data", "S&P 500"))

cp1 <- plot_cumulative_performance_modified(all_strategy_data %>% drop_na()) + xlab("") + theme_bw() + theme(legend.position = "none", legend.title=element_blank())
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "99th Percentile Across All Sectors: 0.208808022053884+/-0.399131588164006"
## 99th Percentile Across All Sectors: 3707407.25
## 99th Percentile Across All Sectors: 3607.41%
## [1] "95th Percentile Across All Sectors: 0.100672606229892+/-0.162447844477771"
## 95th Percentile Across All Sectors: 898167.54
## 95th Percentile Across All Sectors: 798.17%
## [1] "75th Percentile Across All Sectors: 0.0805406108563645+/-0.157748573704633"
## 75th Percentile Across All Sectors: 567965.88
## 75th Percentile Across All Sectors: 467.97%
## [1] "Top Company in Each Sector: 0.114663112249387+/-0.148336429241189"
## Top Company in Each Sector: 1317441.4
## Top Company in Each Sector: 1217.44%
## [1] "All Publicly Traded Companies w/ ACSI Data: 0.0972256498177776+/-0.151010517168814"
## All Publicly Traded Companies w/ ACSI Data: 860506.02
## All Publicly Traded Companies w/ ACSI Data: 760.51%
df <- all_strategy_data

sp500_median <- df %>%
  filter(type == "S&P 500") %>%
  select(year, sp500_median_change = median_change)

# Join the original dataframe with the S&P 500 median changes
df <- df %>%
  left_join(sp500_median, by = "year") %>%
  mutate(median_change = median_change - sp500_median_change) %>%
  select(-sp500_median_change)


cp2 <- ggplot(data = df %>% drop_na(), aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change vs. S&P 500", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")
grid.arrange(cp2 + ggtitle(""), cp1 + ggtitle(""))

Create plot of performance of the core strategies over 5 year intervals in terms of beating the S&P 500

data <- data.frame(
  Strategy = c("95th Percentile Across All Sectors", "90th Percentile Across All Sectors",
               "75th Percentile Across All Sectors", "99th Percentile Across All Sectors",
               "Top Company in Each Sector"),
  `1997 - 2001` = c(0.4, 0.4, 0.4, 0.4, 0.6),
  `2002 - 2006` = c(0.8, 0.8, 0.6, 1, 0.8),
  `2007 - 2011` = c(0.8, 0.6, 0, 0.6, 0.8),
  `2012 - 2016` = c(0.2, 0.2, 0.4, 0.4, 0.8),
  `2017 - 2021` = c(0.2, 0, 0, 0.2, 0.4)
)
data$Strategy <- factor(data$Strategy, levels=c("Top Company in Each Sector", "99th Percentile Across All Sectors", "95th Percentile Across All Sectors", "90th Percentile Across All Sectors", "75th Percentile Across All Sectors"))

data_long <- gather(data, key = "Period", value = "Value", -Strategy)

# rename x_labels since they are currently formatted as X1997-2001, X2002...
x_labels <- c("1997 - 2001", "2002 - 2006", "2007 - 2011", "2012 - 2016", "2017 - 2021")

ggplot(data_long, aes(x = Period, y = Value, group = Strategy, color = Strategy)) +
  geom_line(size= 1) +
  labs(x = "Period", y = "Proportion of Years Beating the S&P 500") + theme_bw() + xlab("Five Year Period") +
  scale_x_discrete(labels = x_labels)